有没有办法使用 vba 在 MS-Access 中截取屏幕截图？
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/2456998/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Is there a way to take a screenshot in MS-Access with vba?
提问by dmr
I want to use vba to take a screenshot (which will then be sent as an email attachment). Ideally, I'd like to take a screenshot of just the active form. Is there any way to do this?
我想使用 vba 截取屏幕截图（然后将其作为电子邮件附件发送）。理想情况下，我只想截取活动表单的屏幕截图。有没有办法做到这一点？
采纳答案by Raj More
You have to use Windows API calls to do this. The following code works in MS Access 2007. It will save BMP files.
您必须使用 Windows API 调用来执行此操作。以下代码适用于 MS Access 2007。它将保存 BMP 文件。
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)
Private Const VK_SNAPSHOT = &H2C
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" _
(PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, _
IPic As IPicture) As Long
'\ Declare a UDT to store a GUID for the IPicture OLE Interface
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
'\ Declare a UDT to store the bitmap information
Private Type uPicDesc
Size As Long
Type As Long
hPic As Long
hPal As Long
End Type
Private Const CF_BITMAP = 2
Private Const PICTYPE_BITMAP = 1
Sub PrintScreen()
keybd_event VK_SNAPSHOT, 1, 0, 0
End Sub
Public Sub MyPrintScreen(FilePathName As String)
Call PrintScreen
Dim IID_IDispatch As GUID
Dim uPicinfo As uPicDesc
Dim IPic As IPicture
Dim hPtr As Long
OpenClipboard 0
hPtr = GetClipboardData(CF_BITMAP)
CloseClipboard
'\ Create the interface GUID for the picture
With IID_IDispatch
.Data1 = &H7BF80980
.Data2 = &HBF32
.Data3 = &H101A
.Data4(0) = &H8B
.Data4(1) = &HBB
.Data4(2) = &H0
.Data4(3) = &HAA
.Data4(4) = &H0
.Data4(5) = &H30
.Data4(6) = &HC
.Data4(7) = &HAB
End With
'\ Fill uPicInfo with necessary parts.
With uPicinfo
.Size = Len(uPicinfo) '\ Length of structure.
.Type = PICTYPE_BITMAP '\ Type of Picture
.hPic = hPtr '\ Handle to image.
.hPal = 0 '\ Handle to palette (if bitmap).
End With
'\ Create the Range Picture Object
OleCreatePictureIndirect uPicinfo, IID_IDispatch, True, IPic
'\ Save Picture Object
stdole.SavePicture IPic, FilePathName
End Sub
There is a Knowledge Base articlethat goes into more depth.
有一篇知识库文章更深入。
回答by bugtussle
Use raj's example to get the image and then this to save
使用 raj 的示例获取图像，然后将其保存
Dim oPic
On Error Resume Next
Set oPic = Clipboard.GetData
On Error GoTo 0
If oPic Is Nothing Then
'no image in clipboard'
Else
SavePicture oPic, "c:\temp\pic.bmp"
end if
