vba截屏保存

    Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
    Enum JpMode
          theScreen = 0 '全屏截图
          theForm = 1 '当前焦点窗口截图
    End Enum
    Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
    Private Declare Function CloseClipboard Lib "user32" () As Long
    Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As Guid, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
    Private Const CF_BITMAP = 2
    Private Type PicBmp
        Size As Long
        Type As Long
        hBmp As Long
        hPal As Long
        Reserved As Long
    End Type
    Private Type Guid
        Data1 As Long
        Data2 As Integer
        Data3 As Integer
        Data4(0 To 7) As Byte
    End Type
   
    Function ApiGetClipBmp() As IPicture
        On Error Resume Next
   
        Dim Pic As PicBmp, IID_IDispatch As Guid
        OpenClipboard 0 'OpenClipboard
        With IID_IDispatch
            .Data1 = &H20400
            .Data4(0) = &HC0
            .Data4(7) = &H46
        End With
        With Pic
            .Size = Len(Pic)
            .Type = 1
            .hBmp = GetClipboardData(CF_BITMAP)
        End With
       
        OleCreatePictureIndirect Pic, IID_IDispatch, 1, ApiGetClipBmp
        'stdole.SavePicture ApiGetClipBmp, "c:clipboard.bmp"
        CloseClipboard
    End Function
   
    Function KeyJp(Optional ByVal TheMode As JpMode = theScreen) As IPictureDisp
       '版权所有，请保留作者信息.QQ：1085992075   '如需商业用途请联系作者
          Call keybd_event(vbKeySnapshot, TheMode, 0, 0) '
          DoEvents
          'Set KeyJp = Clipboard.GetData
    End Function

    Sub dd()
      KeyJp (theScreen)
      SavePicture ApiGetClipBmp, "c:2.bmp"
    End Sub