函 数:
Option Compare Database
Option Explicit
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(bScan As JpMode) As IPicture
On Error Resume Next
Call keybd_event(vbKeySnapshot, bScan, 0, 0) '
DoEvents
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
CloseClipboard
End Function
调用方法:
SavePicture ApiGetClipBmp(theForm), CurrentProject.Path & "\" & Format(Now, "yyyymmddhhnnss") & ".bmp"
调用说明:
先调用截图函数,需要给截图函数传递截图的类型:JpMode。然后将函数的返回值使用SavePicture保存到本地位置。
附 件:
点击下载此附件
演 示: