vba로 MS-Access에서 스크린 샷을 찍는 방법이 있습니까?

Question

vba를 사용하여 스크린 샷을 찍고 싶습니다 (이메일 첨부 파일로 전송됩니다). 이상적으로는 현재 활성화 된 양식의 스크린 샷을 찍고 싶습니다. 이 일을 할 수있는 방법이 있습니까?

Answer 1

이렇게하려면 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 

더 깊이 들어가는 Knowledge Base article이 있습니다.

Answer 2

사용 주권의 예는 이미지를 얻기 위해 다음이 자동화 될

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