Access开发培训
网站公告
·Access专家课堂QQ群号:151711184    ·Access快速开发平台下载地址及教程    ·欢迎加入Access专家课堂微信群!    ·如何快速搜索本站文章|示例|资料    
您的位置: 首页 > 技术文章 > 源码示例

通过VBA自动截图,并保存到指定位置

时 间:2018-11-25 10:40:07
作 者:易勋   ID:35404  城市:上海
摘 要:通过VBA自动截图,并保存到指定位置
正 文:

函   数:

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保存到本地位置。


附   件:

点击下载此附件


演   示:

点击图片查看大图



Access软件网QQ交流群 (群号:54525238)       Access源码网店

常见问答:

技术分类:

相关资源:

专栏作家

关于我们 | 服务条款 | 在线投稿 | 友情链接 | 网站统计 | 网站帮助