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