Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema CheckBox
BildScreenshot zu CheckBox CheckBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema CommandButton
BildScreenshot zu CommandButton CommandButton-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Userform
BildScreenshot zu Userform Userform-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Label
BildScreenshot zu Label Label-Seite mit Beispielarbeitsmappe aufrufen

UserForm im Querformat drucken


Betrifft: UserForm im Querformat drucken
von: Markus
Geschrieben am: 20.09.2019 20:10:18

Liebes Forum,

wie und wo müsste ich folgenden Code ergänzen, damit die Userform im Querformat gedruckt wird.

Private Sub CommandButton1_Click()
 Dim sngHeight As Single, sngWidth As Single
 
 'aktuelle Größe in Variablen merken
 sngHeight = Me.Height
 sngWidth = Me.Width
 
 'eventuell an Deine benötigte Größe anpassen
 Me.Height = 360
 Me.Width = 275
 
 Zoom = 85
 
 Me.PrintForm 'UF ausdrucken
 
 'Form- Größe wieder zurücksetllen
 Me.Height = sngHeight
 Me.Width = sngWidth
 
 Zoom = 100
 
 End Sub
Vielen Dank euch!
  

Betrifft: AW: UserForm im Querformat drucken
von: 1714170.html
Geschrieben am: 20.09.2019 21:54:58

Hallo Markus,

teste mal:

Option Explicit

Private Declare Function MapVirtualKeyA Lib "user32.dll" ( _
    ByVal wCode As Long, _
    ByVal wMapType As Long) As Long
Private Declare Sub keybd_event Lib "user32.dll" ( _
    ByVal bVk As Byte, _
    ByVal bScan As Byte, _
    ByVal dwFlags As Long, _
    ByVal dwExtraInfo As Long)

Private Const KEYEVENTF_KEYUP = &H2

Public Sub Print_Form()
    
    Dim lngAltScan As Long
    Dim objWorksheet As Worksheet
    
    Application.ScreenUpdating = False
    
    lngAltScan = MapVirtualKeyA(vbKeyMenu, 0&)
    Call keybd_event(vbKeyMenu, lngAltScan, 0&, 0&)
    Call keybd_event(vbKeySnapshot, 0&, 0&, 0&)
    DoEvents
    Call keybd_event(vbKeyMenu, lngAltScan, KEYEVENTF_KEYUP, 0&)
    
    Set objWorksheet = ThisWorkbook.Worksheets.Add
    DoEvents
    With objWorksheet
        Call .Paste
        .PageSetup.Orientation = xlLandscape
        Call .PrintOut
        Application.DisplayAlerts = False
        Call .Delete
        Application.DisplayAlerts = True
    End With
    Set objWorksheet = Nothing
    Application.ScreenUpdating = True
End Sub

Gruß
Nepumuk