Blatt im Hochformat "Drucken"
19.02.2018 11:01:29
Andreas
hätte da mal wieder eine Frage.
Hab ein Makro für das Speichern verschiedener Druckbereiche in einer Arbeitsmappe.
Jetzt hab ich das Problem dass alle Druckbereiche bis auf einen im Querformat sind.
Wie bringe ich es fertig den einen Druckbereich im "Hochformat" auszudrucken bzw. wird die Datei als pdf gespeichert.
Bitte euch um Hilfe.
LG Andi!
Sub Steuerblatt_speichern()
Dim Pfad As String, Dateiname As String, Ext As String
Ext = ".pdf"
Pfad = "D:\Daten\Test\"
If Dir(Pfad, vbDirectory) = "" Then
MsgBox "Pfad '" & Pfad & "' existiert nicht"
Exit Sub
End If
Dateiname = Range("D5") & "_146N" & "_" & Range("G5")
If MsgBox("Wollen sie das aktuelle Steuerblatt wirklich übermitteln?", vbYesNo + vbQuestion, _
_
" Achtung ") = vbYes Then
Do Until Dir(Pfad & Dateiname & Ext) = ""
Dateiname = InputBox("Datei existiert schon. Wenn Eintragungen geändert wurden dann _
bitte mit dem Zusatz: ``Verbessert`` ,abspeichern. Datei lässt sich nicht überschreiben! ", "Umbenennen in ", Dateiname)
Loop
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Pfad & Dateiname & Ext, _
Quality:=xlQualityStandard, IncludeDocProperties:= _
True, IgnorePrintAreas:=False, From:=19, To:=20, OpenAfterPublish:=True
' Erzeugt einen Übermittelt Stempel
ActiveSheet.Unprotect Password:="Alina1711"
With Range("JQ8:JR9")
.FormulaR1C1 = "Übermittelt"
With .Interior
.Pattern = xlGray25
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End With
Range("B25").Select
ActiveSheet.Protect Password:="Alina1711"
End If
End Sub
Anzeige