Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1828to1832
1828to1832
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Seitenbereich für PDF festlegen

Forumthread: Seitenbereich für PDF festlegen

Seitenbereich für PDF festlegen
05.05.2021 13:55:19
Andreas
Hallo zusammen,
habe einen VBA Code, in dem eine PDF erstellt und an eine Mail gehängt wird.
Würde Jetzt gerne noch eine Bedingung einfügen und zwar soll die PDF von den ersten 3 Seiten erstellt werden, wenn aber im Tabellenblatt "DQ" Zelle "AH2" eine Zahl steht, die größer als 11 ist, soll die PDF von den ersten 4 Seiten erstellt werden.
Hier mein Code, vielen Dank vorab für eure Hilfe Gruß Andreas 

Public Sub ISF()
Dim sDateiname As String, WSh As Worksheet
Set WSh = ThisWorkbook.Sheets("Tabellen1")
'alle Zeilen einblenden
Cells.EntireRow.Hidden = False
If Sheets("DQ").Range("AH2") = 1 Then
'alle Zeilen einblenden
Cells.EntireRow.Hidden = False
Rows("143:161").EntireRow.Hidden = True
End If
If Sheets("DQ").Range("AH2") = 2 Then
'alle Zeilen einblenden
Cells.EntireRow.Hidden = False
End If
' PDF erzeugen
sDateiname = WSh.Parent.Path & "\" & "Dateiname" & Worksheets("Tabelle1").Range("C11") & "_" & Worksheets("A 1").Range("C7").Value & ".pdf"
WSh.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sDateiname, _
Quality:=xlQualityStandard, OpenAfterPublish:=False
' Mail kreieren
With CreateObject("Outlook.Application").CreateItem(0)
.GetInspector                         ' sorgt für die Signatur
'.To = "Adresse"                  ' Empfänger
.Subject = "Dateiname " & Worksheets("Tabelle1").Range("C11") & "_" & Worksheets("A 1").Range("C7")     ' Betreff
.Body = "Text1" & vbCr & vbCr _
& "Text2" & vbCr _
& "Text3" & vbCr _
& "Text4" _
'& vbCr & .Body                  ' Mailtext mit Signatur
If Dir$(sDateiname)  "" Then .Attachments.Add sDateiname
.Display
End With
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub
Anzeige

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Seitenbereich für PDF festlegen
05.05.2021 15:20:21
Rudi
Hallo,
da gibt's noch die Parameter From: und To:.

WSh.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sDateiname, _
Quality:=xlQualityStandard, OpenAfterPublish:=False, From:=1, To:=3+iif(sheets("DQ").Range("AH2")>11,1,0)
Gruß
Rudi
AW: Seitenbereich für PDF festlegen
05.05.2021 15:35:59
Andreas
Hallo Rudi,
hab deinen Code eingesetzt, die PDF wird aber leider immer für alle 4 Seiten erstellt.
Dieser Block kann sonst auch weg wenn es vielleicht damit zu tun hat?
Dim sDateiname As String, WSh As Worksheet
Set WSh = ThisWorkbook.Sheets("Tabellen1")
'alle Zeilen einblenden
Cells.EntireRow.Hidden = False
If Sheets("DQ").Range("AH2") = 1 Then
'alle Zeilen einblenden
Cells.EntireRow.Hidden = False
Rows("143:161").EntireRow.Hidden = True
End If
If Sheets("DQ").Range("AH2") = 2 Then
'alle Zeilen einblenden
Cells.EntireRow.Hidden = False
End If
Gruß Andreas
Anzeige
AW: Seitenbereich für PDF festlegen
05.05.2021 15:42:56
Rudi
Hallo,
bei mir funktioniert das.
DQ!AH2 &lt= 11: 3 Seiten
DQ!AH2 &gt 11: 4 Seiten
Gruß
Rudi
AW: Seitenbereich für PDF festlegen
05.05.2021 16:39:03
Andreas
Hi Rudi,
hab deinen Code bei mir eingebaut, aber bei mir kommen immer alle 4 Seiten als PDF.
Kannst du mir sagen, wo der Fehler liegen könnte?

Public Sub ISF()
Dim sDateiname As String, WSh As Worksheet
Set WSh = ThisWorkbook.Sheets("Tabelle1")
  WSh.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sDateiname, _
Quality:=xlQualityStandard, OpenAfterPublish:=False, From:=1, To:=3 + IIf(Sheets("DQ").Range("AH2") > 11, 1, 0)

' PDF erzeugen
sDateiname = WSh.Parent.Path & "\" & "Dateiname" & Worksheets("Tabelle1").Range("C11") & "_" & Worksheets("A 1").Range("C7").Value & ".pdf"
WSh.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sDateiname, _
Quality:=xlQualityStandard, OpenAfterPublish:=False
' Mail kreieren
With CreateObject("Outlook.Application").CreateItem(0)
.GetInspector                         ' sorgt für die Signatur
'.To = "Adresse"                  ' Empfänger
.Subject = "Dateiname " & Worksheets("Tabelle1").Range("C11") & "_" & Worksheets("A 1").Range("C7")     ' Betreff
.Body = "Text1" & vbCr & vbCr _
& "Text2" & vbCr _
& "Text3" & vbCr _
& "Text4" _
'& vbCr & .Body                  ' Mailtext mit Signatur
If Dir$(sDateiname)  "" Then .Attachments.Add sDateiname
.Display
End With
End Sub

Anzeige
...denn sie wissen nicht, was sie tun
06.05.2021 13:28:11
Rudi
lösch das:

' PDF erzeugen
sDateiname = WSh.Parent.Path & "\" & "Dateiname" & Worksheets("Tabelle1").Range("C11") & "_" & Worksheets("A 1").Range("C7").Value & ".pdf"
WSh.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sDateiname, _
Quality:=xlQualityStandard, OpenAfterPublish:=False
Gruß
Rudi
Anzeige
AW: ...denn sie wissen nicht, was sie tun
06.05.2021 13:55:05
Andreas
Hi Rudi,
leider weiß ich wirklich ganz und gar nicht was ich hier tue =/
Hab's gelöscht und bekomme einen Laufzeitfehler '-2147024893 (800700003)':
Automatisierungsfehler
Das System kann den angegebenen Pfad nicht finden.
Aber in der VBA habe ich doch garkeinen Pfad :(
Gruß Andreas
Anzeige
AW: ...denn sie wissen nicht, was sie tun
06.05.2021 14:59:50
Rudi
Hallo,
probier mal:

Public Sub ISF()
Dim sDateiname As String, WSh As Worksheet
Set WSh = ThisWorkbook.Sheets("Tabelle1")
sDateiname = WSh.Parent.Path & "\" & "Dateiname" & Worksheets("Tabelle1").Range("C11") _
& "_" & Worksheets("A 1").Range("C7").Value
WSh.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sDateiname, _
Quality:=xlQualityStandard, OpenAfterPublish:=False, _
From:=1, To:=3 + IIf(Sheets("DQ").Range("AH2") > 11, 1, 0)
' Mail kreieren
With CreateObject("Outlook.Application").CreateItem(0)
.GetInspector                         ' sorgt für die Signatur
'.To = "Adresse"                  ' Empfänger
.Subject = "Dateiname " & Worksheets("Tabelle1").Range("C11") & "_" _
& Worksheets("A 1").Range("C7")     ' Betreff
.Body = "Text1" & vbCr & vbCr _
& "Text2" & vbCr _
& "Text3" & vbCr _
& "Text4" _
'& vbCr & .Body                  ' Mailtext mit Signatur
.Attachments.Add sDateiname
.Display
End With
End Sub
Gruß
Rudi
Anzeige
AW: es.... GEEEEHT!
06.05.2021 15:23:03
Andreas
Es geht Rudi, ES GEEEEEEEEEEEHT. Du hast mein Tag gerettet : )
Fast. xD
Das Problem ist jetzt das er keine Mail erstellen mag.
Also die VBA die du mir geschickt hast funktioniert leider nur wenn ich den Teil lösche:
' Mail kreieren
With CreateObject("Outlook.Application").CreateItem(0)
.GetInspector ' sorgt für die Signatur
'.To = "Adresse" ' Empfänger
.Subject = "Dateiname " & Worksheets("Tabelle1").Range("C11") & "_" _
& Worksheets("A 1").Range("C7") ' Betreff
.Body = "Text1" & vbCr & vbCr _
& "Text2" & vbCr _
& "Text3" & vbCr _
& "Text4" _
'& vbCr & .Body ' Mailtext mit Signatur
.Attachments.Add sDateiname
.Display
End With
Aber dann macht er 3 oder 4 Seiten :D
Weißt du wieso er keine Mail erstellen will? Ist mir leider nicht logisch.
Wenn ich den Mailteil drinnen lasse sagt er wieder Laufzeitfehler Automatisierungsfehler.
Gruß Andreas
Anzeige
AW: es.... GEEEEHT!
06.05.2021 15:33:25
Rudi
getestet:

Public Sub ISF()
Dim sDateiname As String, WSh As Worksheet
Set WSh = ThisWorkbook.Sheets("Tabelle1")
sDateiname = WSh.Parent.Path & "\" & "Dateiname" & Worksheets("Tabelle1").Range("C11") _
& "_" & Worksheets("A 1").Range("C7") & ".pdf"
WSh.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sDateiname, _
Quality:=xlQualityStandard, OpenAfterPublish:=False, _
From:=1, To:=3 + IIf(Sheets("DQ").Range("AH2") > 11, 1, 0)
' Mail kreieren
With CreateObject("Outlook.Application").CreateItem(0)
.GetInspector                         ' sorgt für die Signatur
'.To = "Adresse"                  ' Empfänger
.Subject = "Dateiname " & Worksheets("Tabelle1").Range("C11") & "_" _
& Worksheets("A 1").Range("C7")     ' Betreff
.Body = "Text1" & vbCr & vbCr _
& "Text2" & vbCr _
& "Text3" & vbCr _
& "Text4" _
'& vbCr & .Body                  ' Mailtext mit Signatur
.Attachments.Add sDateiname
.Display
End With
End Sub
Gruß
Rudi
Anzeige
AW: es.... GEEEEHT!
06.05.2021 15:59:50
Andreas
Ein rieeeeeeeeeeeeeeeeeesiges DANKESCHÖN Rudi, für deine Arbeit, Zeit und Geduld! Es funktioniert alles wies soll : )
Wünsche dir einen super schönen Abend!
Gruß
man muss nur wissen, was man tut. owT
06.05.2021 16:14:30
Rudi
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige