Clever-Excel-Forum

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

Hi Philipp,

vielleicht hilft dir das weiter:

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

Hallo Michael,

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

VG,
Philipp

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
[attachment=17841]
beim Debuggen steht die gelbe Zeile bei

PHP-Code:
                   .Zoom = .Zoom + Choose(intIndex, 50, 10, 1) 

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.

PhilippB.

Zwergel

PhilippB.

Rabe

schauan