Excel-Druck-Makro

Hallo und frohes Neues.

Folgende Situation:

Excel 2010;Win7;
Excel Sheet´s sollen im Querformat gedruckt werden, es lassen sich aber keine Druckeinstellungen speichern,
wenn man das nächste Sheet öffnet, sind diese dann verworfen.
Ich habe nun ein Makro erstellt indem es mir nach dem drücken von Strg+P das Format auf Quer stellt und druckt.
Soweit so gut.
(Wenn es mehrere Sheets betrifft, öffnet Excel für jedes ein Fenster, was man dann nochmal schließen muss nach dem Drucken, nach 20 fängt´s an zu nerven)

Meine Frage ist folgende:

Kann man dieses Prozedere eleganter gestaltet?
Zu Beispiel, dass das Makro das schließen des aktuellen Fensters mit einbezieht?
Oder ich eine Möglichkeit habe, per drag&drop auf eine Datei den druck aller Dokumente mit einer Vorgabe zu starten, so wie bei einer .bat?

Ist jemand da draußen der weiter helfen kann?

Danke
Gruß

Please also mark the comments that contributed to the solution of the article

Content-Key: 259081

Url: https://administrator.de/contentid/259081

Printed on: April 20, 2024 at 02:04 o'clock

5 Comments

Latest comment

Moin,
gabs schon mal, schaust du in diesen Thread für eine Lösung für dein Anliegen:
VBS - Exceldatei öffnen, drucken und schließen

Grüße Uwe

So schaut das Makro aus:
(Ich weiß leider nicht wie man mit VBA arbeitet)

Sub Querdruck()
'  
' Querdruck Makro  
'  
' Tastenkombination: Strg+p  
'  
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""  
        .PrintTitleColumns = ""  
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = ""  
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""  
        .CenterHeader = ""  
        .RightHeader = ""  
        .LeftFooter = ""  
        .CenterFooter = ""  
        .RightFooter = ""  
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.7)
        .TopMargin = Application.InchesToPoints(0.787401575)
        .BottomMargin = Application.InchesToPoints(0.787401575)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""  
        .EvenPage.CenterHeader.Text = ""  
        .EvenPage.RightHeader.Text = ""  
        .EvenPage.LeftFooter.Text = ""  
        .EvenPage.CenterFooter.Text = ""  
        .EvenPage.RightFooter.Text = ""  
        .FirstPage.LeftHeader.Text = ""  
        .FirstPage.CenterHeader.Text = ""  
        .FirstPage.RightHeader.Text = ""  
        .FirstPage.LeftFooter.Text = ""  
        .FirstPage.CenterFooter.Text = ""  
        .FirstPage.RightFooter.Text = ""  
    End With
    Application.PrintCommunication = True
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
End Sub

Zitat von @MasterBaiter:
(Ich weiß leider nicht wie man mit VBA arbeitet)

na das haben wir hier ja besonders gerne ...

Folgendes Script als *.vbs speichern und das(die) Excelfiles via Drag n' Drop auf das VBS-Script ziehen. Für deinen Test ist Excel sichtbar geschaltet. Das lässt sich aber auch unsichtbar schalten indem man Zeile 11 auf False stellt.

Dim objExcel, fso, files, filename, wb, ws
Set files = WScript.Arguments
If files.Count = 0 Then 
	MsgBox "Es wurde keine Excel-Datei übergeben",vbExclamation  
	WScript.Quit
End If
'Objekte erzeugen  
Set fso = CreateObject("Scripting.FileSystemObject")  
set objExcel = CreateObject("Excel.Application")  
'Excel sichtbar machen  
objExcel.visible = True
'Dialoge unterdrücken  
objExcel.DisplayAlerts = False
For i = 0 To files.Count -1
	filename = files(i)
	If fso.FileExists(filename) Then
		' Datei öffnen  
		Set wb = objExcel.Workbooks.Open(filename,,True)
		'gewünschtes Worksheet drucken  
		Set ws = wb.Worksheets(1)
		objExcel.PrintCommunication = False
		With ws.PageSetup
			.PrintTitleRows = ""  
        	.PrintTitleColumns = ""  
        	.PrintArea = ""  
        	.LeftHeader = ""  
	        .CenterHeader = ""  
	        .RightHeader = ""  
	        .LeftFooter = ""  
	        .CenterFooter = ""  
	        .RightFooter = ""  
	        .LeftMargin = objExcel.InchesToPoints(0.7)
	        .RightMargin = objExcel.InchesToPoints(0.7)
	        .TopMargin = objExcel.InchesToPoints(0.787401575)
	        .BottomMargin = objExcel.InchesToPoints(0.787401575)
	        .HeaderMargin = objExcel.InchesToPoints(0.3)
	        .FooterMargin = objExcel.InchesToPoints(0.3)
	        .PrintHeadings = False
	        .PrintGridlines = False
	        .PrintComments = -4142
	        .PrintQuality = 600
	        .CenterHorizontally = False
	        .CenterVertically = False
	        .Orientation = 2	'Landscape  
	        .Draft = False
	        .PaperSize = 9	'A4  
	        .FirstPageNumber = -4105
	        .Order = 1
	        .BlackAndWhite = False
	        .Zoom = 100
	        .PrintErrors = 0
	        .OddAndEvenPagesHeaderFooter = False
	        .DifferentFirstPageHeaderFooter = False
	        .ScaleWithDocHeaderFooter = True
	        .AlignMarginsHeaderFooter = True
	        .EvenPage.LeftHeader.Text = ""  
	        .EvenPage.CenterHeader.Text = ""  
	        .EvenPage.RightHeader.Text = ""  
	        .EvenPage.LeftFooter.Text = ""  
	        .EvenPage.CenterFooter.Text = ""  
	        .EvenPage.RightFooter.Text = ""  
	        .FirstPage.LeftHeader.Text = ""  
	        .FirstPage.CenterHeader.Text = ""  
	        .FirstPage.RightHeader.Text = ""  
	        .FirstPage.LeftFooter.Text = ""  
	        .FirstPage.CenterFooter.Text = ""  
	        .FirstPage.RightFooter.Text = ""  
		End With
		objExcel.PrintCommunication = True

		'Worksheet drucken  
		ws.PrintOut ,,1,,,,True,,False
		'Workbook wieder schließen  
		wb.Close False
	End If
Next
'Warnmeldungen wieder aktivieren und Excel schließen  
objExcel.DisplayAlerts = True
objExcel.Quit
'Objekte releasen  
Set objExcel = Nothing
Set fso = Nothing

Super Sache

...
Genau das was ich (fast) brauche.
*leider druckt er es nicht im Querformat und schwarz-weiß, der Druck ist aber auf "farbig" eingestellt.

Auch als ich .Orientation = 2 'Landscape mit xlLandscape vertauscht hatte...

Zitat von @MasterBaiter:
Genau das was ich (fast) brauche.
*leider druckt er es nicht im Querformat und schwarz-weiß, der Druck ist aber auf "farbig" eingestellt.

geht hier einwandfrei... vermutlich falsch kopiert.

Auch als ich .Orientation = 2 'Landscape mit xlLandscape vertauscht hatte...

die Konstanten gibts in VBS nicht !

German solved Question Microsoft Office Microsoft

Hotly discussed

How to set up and configure a Linux GRE tunnelAlexWisha - 3 Comments

WIREGUARD VPN ON UDM PRO BEHIND FRITZBOX - HANDSHAKE DID NOT COMPLETEjstricker - 3 Comments

Check of ZFW Firewallgleixnerd - 3 Comments

End of Support dates for Office 2016, 2019 Apps und Productivity ServersDani - 1 Comment