AW: Userform im Querformat drucken
18.07.2009 11:38:41
Tino
Hallo,
habe mal noch etwas getestet und es stimmt, mal funktioniert es mal nicht,
mansch mal wurde sogar nur der zuletzt kopierte Text als Bild eingefügt.
Habe jetzt noch etwas experimentiert, so funktioniert es bei mir recht gut.
Jetzt mache ich die Zwischenablage zuvor leer und noch eine kurze Pause am Ende.
Dialog UserForm1
Option Explicit
Private Sub CommandButton1_Click()
Dim tempSH As Worksheet
Set tempSH = Worksheets.Add
Call ScreenCopy(True)
tempSH.Paste
With tempSH.PageSetup
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
tempSH.PrintOut
DoEvents
Application.DisplayAlerts = False
tempSH.Delete
Application.DisplayAlerts = True
End Sub
kommt als Code in Modul1
Option Explicit
Private Declare Sub keybd_event _
Lib "user32" ( _
ByVal byteVirtualKeycode As Byte, _
ByVal byteScan As Byte, _
ByVal lFlags As Long, _
ByVal lExtraInfo As Long)
Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function EmptyClipboard Lib "user32" () As Long
Public Declare Function CloseClipboard Lib "user32" () As Long
Private Const KEYEVENTF_KEYUP As Long = &H2 ' Taste lösen
Private Const VK_MENU As Byte = &H12 ' Alt-Taste
Private Const VK_SNAPSHOT As Byte = &H2C ' Druck/PrtScrn-Taste
Private Function ClearClipboard()
OpenClipboard (0&)
EmptyClipboard
CloseClipboard
End Function
Sub ScreenCopy(Optional ByVal ActiveWindow As Boolean = False)
' Überträgt eine Bildschirmkopie des Desktops (ActiveWindow = False)
' oder des aktiven Fensters (ActiveWindow = True) in die Zwischenablage.
Call ClearClipboard 'Zwischenablage leer machen
If ActiveWindow Then
' Nur das aktive Fenster abfotografieren
' => Alt-Taste einbeziehen
keybd_event VK_MENU, 0, 0, 0 ' Alt 'runter
keybd_event VK_SNAPSHOT, 0, 0, 0 ' Druck ' runter
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0 ' Druck hoch
keybd_event VK_MENU, 0, KEYEVENTF_KEYUP, 0 ' Alt hoch
Else
' Den gesamten Desktop abfotografieren
keybd_event VK_SNAPSHOT, 0, 0, 0 ' Druck ' runter
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0 ' Druck hoch
End If
DoEvents
Application.Wait Now + TimeSerial(0, 0, 1)
End Sub
Sub Schaltfläche1_KlickenSieAuf()
UserForm1.Show
End Sub
Gruß Tino