Option Explicit
Private Const HORZRES = 8            '  Horizontal width in pixels
Private Const VERTRES = 10          '  Vertical width in pixels
Private Const CF_BITMAP = 2
Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = sourcePrivate Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private 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
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Sub Command2_Click()
Dim hScrDC As Long
hScrDC = GetDC(Picture1.hwnd)
Dim hMemDC As Long
hMemDC = CreateCompatibleDC(hScrDC)
Dim xScrn As Integer
Dim yScrn As Integer
Picture1.ScaleMode = vbPixels
xScrn = Picture1.ScaleWidth '+ 200
yScrn = Picture1.ScaleHeight '+ 200
Dim hBitmap As Long
hBitmap = CreateCompatibleBitmap(hScrDC, xScrn, yScrn)
Dim hOldmap As Long
hOldmap = SelectObject(hMemDC, hBitmap)
BitBlt hMemDC, 0, 0, xScrn, yScrn, hScrDC, 0, 0, SRCCOPY
hBitmap = SelectObject(hMemDC, hOldmap)
DeleteDC hScrDC
DeleteDC hMemDC
OpenClipboard hwnd
EmptyClipboard
SetClipboardData CF_BITMAP, hBitmap
CloseClipboard
Dim pictureX As Picture
Set pictureX = Clipboard.GetData()
Printer.Print " "
Printer.PaintPicture pictureX, 0, 0
Printer.EndDoc
End Sub