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