12.04.2013

UserForm - Drucken - xlLandscape - xlPortrait...

Frage: Ich habe verschiedene UserFormen. Diese möchte ich gerne drucken. Ist die UserForm breiter wie höher, dann im querformat drucken - sonst nicht. Wie geht das?

I have different user forms. This I would like to print. Is the UserForm wider than higher, then in landscape print - otherwise not. How does it work?

Hier noch eine Beispieldatei / Here's a sample file:
UserForm - Drucken - xlLandscape - xlPortrait...[XLS 70 KB]

' Code gehört in UserForm1 / Code is in UserForm1

Option Explicit
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 Declare Function MapVirtualKey Lib "user32" _
    Alias "MapVirtualKeyA" (ByVal wCode As Long, _
    ByVal wMapType As Long) As Long
Const VK_MENU = &H12 'ALT
'--------------------------------------------------------------------------
' Module    : UserForm1
' Procedure : CommandButton1_Click
' Author    : Case (Ralf Stolzenburg)
' Date      : 12.04.2013
' Purpose   : Tasten ALT & Druck drücken...
'--------------------------------------------------------------------------
Private Sub CommandButton1_Click()
    keybd_event VK_MENU, MapVirtualKey(VK_MENU, 0), 0, 0 ' 0 = ALT drücken
    keybd_event vbKeySnapshot, 0, 0, 0
    DoEvents
    keybd_event VK_MENU, MapVirtualKey(VK_MENU, 0), 2, 0 ' 2 = ALT loslassen
    If Me.Width > Me.Height Then
        Application.OnTime Now + TimeSerial(0, 0, 2), "Main"
    Else
        Application.OnTime Now + TimeSerial(0, 0, 2), "'Main True'"
    End If
    Unload Me
End Sub

' Code gehört in UserForm2 / Code is in UserForm2

Option Explicit
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 Declare Function MapVirtualKey Lib "user32" _
    Alias "MapVirtualKeyA" (ByVal wCode As Long, _
    ByVal wMapType As Long) As Long
Const VK_MENU = &H12 'ALT
'--------------------------------------------------------------------------
' Module    : UserForm2
' Procedure : CommandButton1_Click
' Author    : Case (Ralf Stolzenburg)
' Date      : 12.04.2013
' Purpose   : Tasten ALT & Druck drücken...
'--------------------------------------------------------------------------
Private Sub CommandButton1_Click()
    keybd_event VK_MENU, MapVirtualKey(VK_MENU, 0), 0, 0 ' 0 = ALT drücken
    keybd_event vbKeySnapshot, 0, 0, 0
    DoEvents
    keybd_event VK_MENU, MapVirtualKey(VK_MENU, 0), 2, 0 ' 2 = ALT loslassen
    If Me.Width > Me.Height Then
        Application.OnTime Now + TimeSerial(0, 0, 2), "Main"
    Else
        Application.OnTime Now + TimeSerial(0, 0, 2), "'Main True'"
    End If
    Unload Me
End Sub

' Code gehört in ein Modul / Code is in a module

Option Explicit
'--------------------------------------------------------------------------
' Module    : Module1
' Procedure : Main
' Author    : Case (Ralf Stolzenburg)
' Date      : 12.04.2013
' Purpose   : UserForm im Querformat ausdrucken...
'--------------------------------------------------------------------------
Sub Main(Optional blnTMP As Boolean = False)
    Dim shpShape As Shape
    Dim lngCalc As Long
    ' Wenn ein Fehler auftritt gehe zu der angegebenen Sprungmarke
    On Error GoTo Fin
    ' Die Excelapplikation wird ruhig gestellt - UNBEDINGT wieder einschalten
    With Application
        ' Das Bildschirmaktualisierung wird unterbrochen
        .ScreenUpdating = False
        ' Ereignisroutinen werden deaktiviert
        .EnableEvents = False
        ' Auslesen der momentanen Einstellung für die Berechnung
        lngCalc = .Calculation
        ' Setzen der Berechnung auf "Manuell"
        .Calculation = xlCalculationManual
        '  Eingabeaufforderungen und Warnmeldungen unterdrücken
        .DisplayAlerts = False
    End With
    ' Neues Worksheet erzeugen
    ThisWorkbook.Worksheets.Add
    With ActiveSheet
        ' Bild der UserForm einfügen
        .Paste
        ' Wenn UserForm breiter als höher, dann...
        If blnTMP = False Then
            ' Horizontal und vertikal zentrieren - Querformat
            ' Hier könnten auch noch die Seitenränder verkleinert werden
            With .PageSetup
                .CenterHorizontally = True
                .CenterVertically = True
                .Orientation = xlLandscape
            End With
            ' Bildhöhe anpassen
            With .Shapes(1)
                .Height = 480
            End With
        Else
            ' Horizontal und vertikal zentrieren - Längsformat
            With .PageSetup
                .CenterHorizontally = True
                .CenterVertically = True
                .Orientation = xlPortrait
            End With
            ' Bildbreie anpassen
            With .Shapes(1)
                .Width = 400
            End With
        End If
        ' Tabellenblatt drucken
        .PrintOut
        ' Tabellenblatt löschen
        .Delete
        ' Umbruchvorschau ausschalten
        ActiveSheet.DisplayAutomaticPageBreaks = False
    End With
Fin:
    ' Die Applikation aufwecken
    With Application
        ' Bildschirmaktualisierung wieder einschalten
        .ScreenUpdating = True
        ' Ereignisroutinen werden wieder aktiviert
        .EnableEvents = True
        ' Setzen der Berechnung auf den gemerkten Wert
        .Calculation = lngCalc
        ' Eingabeaufforderungen und Warnmeldungen wieder zulassen
        .DisplayAlerts = True
        ' Abbrechen Ausschneide- bzw. Kopiermodus und entfernen des Laufrahmens
        .CutCopyMode = True
    End With
    ' Wenn ein Fehler auftritt gib ihn aus mit Fehlernummer und Beschreibung
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub
Sub UF1_Show()
    UserForm1.Show
End Sub
Sub UF2_Show()
    UserForm2.Show
End Sub

Formeln auf einer UserForm in einer TextBox darstellen...

Formeln auf einer UserForm in einer TextBox anzeigen. Z. B. "Formula", "FormulaLocal"... und wie muss die Formel in VBA ...