如何在VBA中进行屏幕截图并保存到桌面？
通过
API
函数
实现屏幕截图功能，代码如下：
Option Ex
pl
i
ci
t
Declare Function BitBlt Lib "gdi32" (ByVal hDestDC
As
Long, ByVal x
As
Long, ByVal y
As
Long, ByVal nWidth
As
Long, ByVal nHeight
As
Long, ByVal hSrcDC
As
Long, ByVal xSrc
As
Long, ByVal ySrc
As
Long, ByVal dwRop
As
Long)
As
Long
Declare Function GetDC Lib "user32" (ByVal hWnd
As
Long)
As
Long
Declare Function Rele
as
eDC Lib "user32" (ByVal hWnd
As
Long, ByVal hDC
As
Long)
As
Long
Declare Function
Cr
eateCompatibleDC Lib "gdi32" (ByVal hDC
As
Long)
As
Long
Declare Function
Cr
eateCompatibleBitmap Lib "gdi32" (ByVal hDC
As
Long, ByVal nWidth
As
Long, ByVal nHeight
As
Long)
As
Long
Declare Function SelectObject Lib "gdi32" (ByVal hDC
As
Long, ByVal hObject
As
Long)
As
Long
Declare Function DeleteDC Lib "gdi32" (ByVal hDC
As
Long)
As
Long
Declare Function DeleteObject Lib "gdi32" (ByVal hObject
As
Long)
As
Long
Sub S
cr
eenCapture()
Dim w As Long, h As Long
Dim hDesktopWnd As Long, hDesktopDC As Long, hCaptureDC As Long
Dim hBmp As Long, hOldBmp As Long
hDesktopWnd = GetDesktopWindow()
hDesktopDC = GetDC(hDesktopWnd)
hCaptureDC = CreateCompatibleDC(hDesktopDC)
w = GetSystemMetrics(SM_CXSCREEN)
h = GetSystemMetrics(SM_CYSCREEN)
hBmp = CreateCompatibleBitmap(hDesktopDC, w, h)
hOldBmp = SelectObject(hCaptureDC, hBmp)
BitBlt hCaptureDC, 0, 0, w, h, hDesktopDC, 0, 0, SRCCOPY
hBmp = SelectObject(hCaptureDC, hOldBmp)
Call SaveToDesktop(hBmp) '调用保存图片到桌面函数
DeleteObject hBmp
DeleteDC hCaptureDC
ReleaseDC hDesktopWnd, hDesktopDC
End Sub
'获取桌面窗口句柄函数
Declare Function GetDesktopWindow Lib "user32.dll" () As Long
'获取屏幕参数函数
Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
'取得窗口句柄设备环境
社区干货
特惠活动
如何在VBA中进行屏幕截图并保存到桌面？
-优选内容
如何在VBA中进行屏幕截图并保存到桌面？
-相关内容
