Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
808to812
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
808to812
808to812
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

UF drucken

UF drucken
10.10.2006 07:17:41
Frederic
Guten Morgen, ExcelForum,
ich hab eine UF, die 7 Spalten in unterschiedlichen Breiten hat, sprich eher ein Querformat.
Nun möchte ich diese UF gerne drucken. Mit "Me.PrintForm" schaut das aber nicht wirklich gut aus. Er druckt im Hochformat, nur die halbe Seite und das meiste schneidet er ab.
Gibt es eine Möglichkeit, das besser anzupassen?
Gruß.
Frederic

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

Betreff
Datum
Anwender
Anzeige
AW: UF drucken
10.10.2006 08:42:33
otto
Hi,
probier mal das, so drucke ich das aus - hab den Code auch mal aus dem Forum. Die Größe und das Format kannst du noch anpassen.
Option Explicit
Private Declare Function MapVirtualKey Lib "user32.dll" Alias "MapVirtualKeyA" ( _
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
Private Const VK_MENU = &H12
Private Const lngMargin = &H1 '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, 1, 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 = False
.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

Private Sub drucken_Click()
Call prcPrintForm(Me.Name)
End Sub

Gruß
otto
Anzeige
AW: UF drucken
10.10.2006 10:18:46
Frederic
Hi Otto,
danke für den Code. Leider kann ich aber die Höhe nicht beeinflussen.
Er druckt nur das, was auch in der Ansicht ist, dass was darunter ist, kommt nicht. Liegt es am Scrollbalken? Hab eben mehr Einträge, die nicht auf einen Blick in die UF passen...
Vielleicht fällt dir noch was ein?
Gruß.
Frederic
AW: UF drucken
10.10.2006 10:50:34
otto
Sorry,
da hab ich leider auch keine Idee mehr.
otto
AW: UF drucken
10.10.2006 12:47:10
Wolfgang
Hallo Frederic,
Ich habe da ein Makro für Dich was ich aus dem Forum habe. Probier es doch mal.
Bei mir hat es sehr gut funktioniert.
Ich habe es bei sehr großen UserForm angewendet.
Es wird im Querformat gedruckt passent für die ganze Seite.
Option Explicit
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 KEYEVENTF_EXTENDEDKEY = &H1
Private Const VK_SNAPSHOT = &H2C
Private Const VK_MENU = &H12
Private Const VK_LMENU = &HA4

Private Sub CommandButton1_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

Ich hoffe es hilft Dir
Gruß Wolfgang
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige