Form Ausdruckn Querformat

06/05/2010 - 02:14 von Jens Meier | Report spam
Hallo NG,

ich habe folgendes Macro zum Druck einer Form gefunden. Hab das ganze in ein
leeres Modul gepastet, doch beim Aufruf aus der Form erhalte ich Fehler
1004: Zoom eigenschaft kann nicht festgelegt werden. Kann mir hier jmd
helfen? Bei einer Abgespeckten Variante klappts einbandfrei, aber die Form
wird nicht optimal uaf die Seite eingepasst.



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 = 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, xlLandscape,
xlPortrait)
.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)










<<<< Fehler
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,

Jens
 

Lesen sie die antworten

#1 Andreas Killer
07/05/2010 - 08:05 | Warnen spam
Jens Meier schrieb:

ich habe folgendes Macro zum Druck einer Form gefunden. Hab das ganze in ein
leeres Modul gepastet, doch beim Aufruf aus der Form erhalte ich Fehler
1004: Zoom eigenschaft kann nicht festgelegt werden. Kann mir hier jmd


Ja, das liegt aber offenbar daran das...

Do Until ExecuteExcel4Macro("Get.Document(50)") > 1


...hier die Seitenzahl nicht erkannt wird. Ersetzt man das alte
Excel4Macro durch VPageBreaks/HPageBreaks funktioniert es allerdings
ebensowenig.

Da wir aber nur eine Grafik drucken wollen müssen wir ja nicht
unbedingt in den Druckeinstellungen zoomen, wir können ja auch die
Grafik in der Tabelle vergrößern und dann funktionieren
VPageBreaks/HPageBreaks wunderbar.

Andreas.

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 = 1 'Breite der Seitenrànder in cm

Public Sub prcPrintForm(objForm As Object)
'Druckt eine Userform angepasst an die Papiergröße aus
Dim intAltScan As Integer, intIndex As Integer
Dim S As Shape

Application.ScreenUpdating = False
'Screenshot der Userform machen
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&
'Tabelle hinzufügen
ThisWorkbook.Worksheets.Add
With ActiveSheet
'Grafik einfügen
.Paste
'Drucker einstellen
With .PageSetup
.Orientation = IIf(objForm.Width > objForm.Height, _
xlLandscape, xlPortrait)
.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
End With
'Zugriff auf die Grafik
Set S = .Shapes(1)
'Sicherstellen das das Seitenverhàltnis gesperrt ist
S.LockAspectRatio = msoTrue
'Grafik in 3 Schritten anpassen 50%,10%,1%
For intIndex = 1 To 3
'Solange kein Seitenumbruch
Do While (.VPageBreaks.Count = 0) And _
(.HPageBreaks.Count = 0)
'Vergrößern
S.Width = S.Width * _
Choose(intIndex, 1.5, 1.1, 1.01)
Loop
'Solange Seitenumbruch
Do While (.VPageBreaks.Count > 0) Or _
(.HPageBreaks.Count > 0)
'Verkleinern
S.Width = S.Width * _
(1 / Choose(intIndex, 1.5, 1.1, 1.01))
Loop
Next
'Tabelle drucken
.PrintOut
'Tabelle löschen
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With
Application.ScreenUpdating = True
End Sub

Ähnliche fragen