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

巴特西

vba截屏保存

最新文章

热门文章