Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1028to1032
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
Inhaltsverzeichnis

VBA Querdruck DinA5 auf DinA4 Hochformat

VBA Querdruck DinA5 auf DinA4 Hochformat
07.12.2008 11:40:36
Peter
Hallo,
habe eine Userform die ich aufrufe, dort sind 2 CommandButtons auf die entweder auf DinA5 oder DinA4 gedruckt werden soll.
Habe nun den Makrorecorder laufen lassen.

Private Sub CommandButton1_Click()
'Sub Karte_Druck()
' Karte_Druck Makro Din A 4
Application.ScreenUpdating = False
' einblenden
Rows("40:68").Select
Selection.EntireRow.Hidden = False
Range("A40:T67").Select
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = "$A$40:$T$67"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = "&""Arial,Standard""&8"
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = -3
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Range("T2").Select
'ausblenden
Rows("40:68").Select
Selection.EntireRow.Hidden = True
Unload Me ' Userform abschalten
Application.ScreenUpdating = True
End Sub



Private Sub CommandButton2_Click()
'Sub Karte_Druck()
' Karte_Druck Makro Din A 5
Application.ScreenUpdating = False
' einblenden
Rows("40:53").Select
Selection.EntireRow.Hidden = False
' Range("A40:T53").Select
' With ActiveSheet.PageSetup
'    .PrintTitleRows = ""
'   .PrintTitleColumns = ""
'End With
ActiveSheet.PageSetup.PrintArea = "$A$40:$T$53"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = "&""Arial,Standard""&8"
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = -3
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA5
' .FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Range("T2").Select
'ausblenden
Rows("40:53").Select
Selection.EntireRow.Hidden = True
Unload Me ' Userform abschalten
Application.ScreenUpdating = True
End Sub


Das größte Problem scheint zu sein der Seitenumbruch von Din A4 auf DinA5.
Mit dem Makrorecorder geht es nicht, bei mir jedenfalls nicht.
Wie kann man das hinbekommen.
Gruß Peter

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Querdruck DinA5 auf DinA4 Hochformat
08.12.2008 17:51:00
fcs
Hallo Peter,
eigentlich sollte es funktionieren. Kann aber sein, dass der Druckvorgang und die gleichzeitige Anzeige des Userforms Probleme machen.
Deshalb hab ich den Hide-Befehl zusätzlich am Anfang der Prozeduren eingefügt.
Außerdem hab ich ein wenig die Select/Selection-Anweisungen eleminiert.
Die Print-Qualityeinstellung funktionierte bei mir auch nicht.
Das Drucken auf A5 funktioniert natürlich nur, wenn du an deinem Drucker auch A5-Papier verarbeiten kannst. Evtl. geht das nur über manuelle Papierzufuhr. Automatisch ?
Gruß
Franz

Private Sub CommandButton1_Click()
'Sub Karte_Druck()
' Karte_Druck Makro Din A 4
Application.ScreenUpdating = False
Dim wks As Worksheet, rngPrint As Range, rngHide As Range
Set wks = ActiveSheet
UserForm1.Hide
With wks
'Druckbereich
Set rngPrint = .Range("A40:T67")
Set rngHide = .Rows("40:68")
' einblenden
rngHide.EntireRow.Hidden = False
With .PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
.PageSetup.PrintArea = rngPrint.Address '"$A$40:$T$67"
With .PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = "&""Arial,Standard""&8"
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
'       .PrintQuality = -3
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlPortrait
.Draft = False
.Papersize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
End With
End With
With rngPrint
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
End With
wks.PrintOut Copies:=1, Collate:=True
'  wks.PrintPreview
With rngPrint
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
.Borders(xlInsideVertical).LineStyle = xlNone
End With
Range("T2").Select
'ausblenden
rngHide.EntireRow.Hidden = True
Unload Me ' Userform abschalten
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton2_Click()
'Sub Karte_Druck()
' Karte_Druck Makro Din A 5
Application.ScreenUpdating = False
' einblenden
Dim wks As Worksheet, rngPrint As Range, rngHide As Range
Set wks = ActiveSheet
Me.Hide
With wks
'Druckbereich
Set rngPrint = .Range("A40:T53")
Set rngHide = .Rows("40:53")
' einblenden
rngHide.EntireRow.Hidden = False
With .PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
.PageSetup.PrintArea = rngPrint.Address
With .PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = "&""Arial,Standard""&8"
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
'        .PrintQuality = -3
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlPortrait
.Draft = False
.Papersize = xlPaperA5
' .FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
End With
End With
With rngPrint
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
End With
'  wks.PrintPreview
wks.PrintOut Copies:=1, Collate:=True
With rngPrint
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
.Borders(xlInsideVertical).LineStyle = xlNone
End With
Range("T2").Select
'ausblenden
rngHide.EntireRow.Hidden = True
Unload Me ' Userform abschalten
Application.ScreenUpdating = True
End Sub


Anzeige
AW: VBA Querdruck DinA5 auf DinA4 Hochformat
08.12.2008 18:52:00
Peter
Hallo Franz
nett das Du Dich gemeldest hast , mit einem Vorschlag.
Das Problem ist Din A5
Habe es jetzt als Din A5 als Din A4 Laufen, klappt immer noch am besten, und langt für meine Zwecke.
Danke das Du Franz geantwortet hast.
Gruß Peter

314 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige