Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
680to684
680to684
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Userform auf ein Blatt A4 drucken
14.10.2005 13:48:11
Horst
Hallo User,
nachdem ich endlos im Archiv gesucht habe, um eine Lösung füpr mein Problem zu finden möchte ich nun auf Euch zurückgreifen. Mein Problem:
Ich möchte meine Userform mit notwendiger Größe von Höhe 508 und Weite von 765 über einen VBA Befehl in der selben Userform ausdrucken. Bisherige Ansätze führen immer dazu, dass die Userform als Schnappschuß betrachtet, in der Originalgröße 4 seiten beim Ausdruck benötigt. Wie lauten die paar Codezeilen, welche die Userform für den Ausdruck auf A4 verkleinern. Unten ist noch der alte Code, welchen ich im Archiv fand angefügt:
Horst

Private Sub cmd_Druck_Click()
Dim wshTemp As Worksheet
DoEvents
keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
DoEvents
ThisWorkbook.Worksheets.Add
ActiveSheet.Name = "Temp"
Set wshTemp = ThisWorkbook.Worksheets("Temp")
With wshTemp
.Paste
.PageSetup.Orientation = xlLandscape
.PrintOut
.DrawingObjects.Delete
End With
Application.DisplayAlerts = False
ThisWorkbook.Worksheets("Temp").Delete
Application.DisplayAlerts = True
End Sub

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Userform auf ein Blatt A4 drucken
14.10.2005 14:05:23
Nepumuk
Hi,
so:
' **********************************************************************
' Modul: basPrint Typ: Allgemeines Modul
' **********************************************************************

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(strFrmName As String)
    Dim intAltScan As Integer, intIndex As Integer
    Dim lngMode As Long
    Application.ScreenUpdating = False
    intAltScan = MapVirtualKey(VK_MENU, 0)
    keybd_event VK_MENU, intAltScan, 0, 0
    keybd_event vbKeySnapshot, lngMode, 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(UserForms.Add(strFrmName).Width > _
                UserForms.Add(strFrmName).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

Der Aufruf erfolgt mit: Call prcPrintForm(Me.Name)
Gruß
Nepumuk

Anzeige
AW: Userform auf ein Blatt A4 drucken
14.10.2005 16:12:05
Horst
Hallo Nepumuk,
riesigen Dank für den Code, der Rechner rödelt ganz schön, ist fast durch bleibt dann aber bei
.Zoom = .Zoom - Choose(intIndex, 50, 10, 1)
in der hängen und meldet:
"Laufzeitfehler 1004, Die Zoomeigenschaft des PageSetup-Objektes kann nicht festgelegt werden."
Woran liegt das, muss ich an meiner userform "frm_Eingabemaske" in den Eigenschaften was verändern oder ist dort ein Tippfehler?
Horst
AW: Userform auf ein Blatt A4 drucken
14.10.2005 17:03:52
Nepumuk
Hallo Horst,
kann ich so nicht nachvollziehen. Mach mal per Drag & Drop, im Projektexplorer, eine Kopie des Userforms in eine neue Mappe und lade die mal auf den Server.

Gruß
Nepumuk

Anzeige
AW: Userform auf ein Blatt A4 drucken
18.10.2005 22:00:43
Horst
Hallo Nepumuk,
habe den "Fehler" gefunden. Ich habe den Zoomfaktor von 10 auf 160 hochgesetzt und die fehlermeldung verschwand. Ich weiss zwar nicht wirklich, was dort im Hintergrund abläuft, aber der Ausdruck ist jetzt erste Sahne. Habe vorher noch mit verschiedenen Zoomfaktoren probiert, aber 160 ist der Beste.
So sieht das Ganze nun aus.
Public

Sub prcPrintForm(strFrmName As String)
Dim intAltScan As Integer, intIndex As Integer
Dim lngMode As Long
Application.ScreenUpdating = False
intAltScan = MapVirtualKey(VK_MENU, 0)
keybd_event VK_MENU, intAltScan, 0, 0
keybd_event vbKeySnapshot, lngMode, 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(UserForms.Add(strFrmName).Width > _
UserForms.Add(strFrmName).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 = 160
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

Vielen Dank nochmal für Deine schnelle Hilfe,
Horst !!!
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige