Multipage im Querformat drucken

[PhilippB.]

Hallo,

ich habe eine Multipage mit 7 Seiten und möchte diese gern (bei Bedarf) als ein Dokument drucken bzw. als pdf-Datei abspeichern. 
Meine erste Idee (gefunden im Netz):

Private Sub CommandButton1_Click()
For i = 0 To 9
Me.MultiPage1.Value = i
Me.PrintForm
Next
End Sub

Jedoch können die Seiten nur einzeln gedruckt werden und sind zudem im Hochformat sowie die Ränder demzufolge abgeschnitten.
Kann vllt jemand einen Tipp geben? Recherchiere gerade intensiv. 

Gruß,
Philipp

[Zwergel]

Hi Philipp,

vielleicht hilft dir das weiter:

http://www.herber.de/forum/archiv/752to756/t755936.htm

[PhilippB.]

Hallo Michael,

vielen Dank. Das hatte ich kurze Zeit später auch ergoogelt. Mal schauen ob das klappt.

VG,
Philipp

[Rabe]

Hi,

ich habe es getestet.

Zuerst das Makro, das jede Page der Userform in Hochformat auf ein eigenes Blatt ausdruckt,
Ziel ist das Abspeichern als ein PDF mit allen 7 Pages im Querformat:

Code:

Private Sub cmd_Drucken_Click() 'Drucken
   Dim curPage As Long
   Dim iCtr As Long

   curPage = Me.MultiPage1.Value
   For iCtr = 0 To Me.MultiPage1.Pages.Count - 1
   Me.MultiPage1.Value = iCtr
   Me.PrintForm
   Next iCtr
   Me.MultiPage1.Value = curPage
   
'    Call prcPrintForm(Me)

End Sub

dann die Makros, aus dem Link von Michael:

Code:

Option Explicit

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

Private Const KEYEVENTF_KEYUP = &H2
Private Const VK_MENU = &H12
Private Const lngMargin = 1& 'Breite der Seitenränder in cm

Public Sub prcPrintForm(objForm As Object)
   Dim intAltScan As Integer, intIndex As Integer
   Application.ScreenUpdating = False
   intAltScan = MapVirtualKey(VK_MENU, 0&)
   keybd_event VK_MENU, intAltScan, 0&, 0&
   keybd_event vbKeySnapshot, 0&, 0&, 0&
   DoEvents
   keybd_event VK_MENU, intAltScan, KEYEVENTF_KEYUP, 0&
   ThisWorkbook.Worksheets.Add
   Rows.RowHeight = 3
   Columns.ColumnWidth = 0.83
   With ActiveSheet
       .Paste
       With .PageSetup
           .Orientation = IIf(objForm.Width > objForm.Height, 2, 1)
           .LeftMargin = Application.CentimetersToPoints(lngMargin)
           .RightMargin = Application.CentimetersToPoints(lngMargin)
           .TopMargin = Application.CentimetersToPoints(lngMargin)
           .BottomMargin = Application.CentimetersToPoints(lngMargin)
           .HeaderMargin = Application.CentimetersToPoints(0)
           .FooterMargin = Application.CentimetersToPoints(0)
           .CenterVertically = True
           .CenterHorizontally = True
           .Zoom = 10
           For intIndex = 1 To 3
               Do Until ExecuteExcel4Macro("Get.Document(50)") > 1
                   .Zoom = .Zoom + Choose(intIndex, 50, 10, 1)
               Loop
               .Zoom = .Zoom - Choose(intIndex, 50, 10, 1)
           Next
       End With
       .PrintOut
       Application.DisplayAlerts = False
       .Delete
       Application.DisplayAlerts = True
   End With
   Application.ScreenUpdating = True
End Sub

Mit dem Drucken-Button auf Page 7 rufe ich mit

PHP-Code:

  Call prcPrintForm(Me) 


die Funktion auf. Dabei kommt der Fehler
   
beim Debuggen steht die gelbe Zeile bei

PHP-Code:

                   .Zoom = .Zoom + Choose(intIndex, 50, 10, 1) 


[schauan]

Hallo Ralf,

eventuell gibt es einen Grenzwert beim Zoom, siehe z.B. im Ribbon Ansicht bei Zoom, geht bis 200. Das könnte man mit ... = Min(200, ...) eingrenzen, um diese mögliche Fehlerursache zu vermeiden.