画面のハードコピーを印刷


うまくいかない環境があるみたいなのでご注意を
MSの公開しているサンプルを使えばうまくいくと思います。
Jump-> http://support.microsoft.com/support/kb/articles/Q161/2/99.asp

拡大処理などはしてないので、自分でしてね。


Private Declare Function GetDC Lib "user32" (ByVal hwnd 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 Const SRCCOPY = &HCC0020

Private Sub Command1_Click()
    Dim hDCScreen As Long
    Dim hDCPrinter As Long
    Dim nWidth As Long
    Dim nHeight As Long
    
    nWidth = Screen.Width / Screen.TwipsPerPixelX
    nHeight = Screen.Height / Screen.TwipsPerPixelY
    
    hDCScreen = GetDC(0)
    hDCPrinter = Printer.hdc
    
    Printer.Print " "
    Debug.Print BitBlt(hDCPrinter, 0, 0, nWidth, nHeight, hDCScreen, 0, 0, SRCCOPY)
    
    Call Printer.EndDoc
End Sub




サンプル PrintScreen.zip