Option Explicit
' zunächst die benötigten API-Deklarationen
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 GetDC Lib "user32" _
  (ByVal hWnd As Long) As Long
 
Private Declare Function ReleaseDC Lib "user32" _
  (ByVal hWnd As Long, ByVal hdc As Long) As Long
 
'Private Declare Function GetDesktopWindow Lib "user32" _
'  () As Long
 
Public Sub ScreenToPrinter()
  Dim hWnd As Long
  Dim DC As Long
 
  ' Desktop-Fenster
  hWnd = Form1.hWnd
 
  ' Zugang zum Device-Context
  DC = GetDC(hWnd)
 
  ' Screen drucken
  Printer.Print
  BitBlt Printer.hdc, 0, 0, _
    Form1.Width / Screen.TwipsPerPixelX, _
    Form1.Height / Screen.TwipsPerPixelY, DC, 0, 0, _
    vbSrcCopy
 
  ' DC wieder freigeben
  ReleaseDC hWnd, DC
 
  ' Druckauftrag beenden
  Printer.EndDoc
End Sub