PDF Lesezeichen aus Excel heraus erstellen und Lesezeichenleiste anzeigen

Computer: Software & Programmierung Visual Basic
#1

Hallo,
ich habe in Excel einen VBA Code geschrieben, um eine Lesezeichen Struktur in ein bestehendes PDF (Acrobat XI) einzufügen. Nun kriege ich es nicht hin per VBA dem Dokument „einzuimpfen“ die Lesezeichenleiste als Standard anzuzeigen. Kennt sich hier jemand aus und kann helfen? Es ist wahrscheinlich nur eine Zeile, aber ich komme nicht drauf.
Hier mal mein bisheriger Code:
gPDFPath = „C:\Test\Test.pdf“
Worksheets(„Lesezeichen“).Activate
Anzahl = ThisWorkbook.Sheets(„Lesezeichen“).UsedRange.Rows.Count
ReDim LESE(Anzahl)
For i = 2 To Anzahl
LESE(i - 1).Eintrag = Range(„A“ & i)
LESE(i - 1).Seite = Range(„B“ & i)
LESE(i - 1).Gliederung = Range(„C“ & i)
LESE(i - 1).Ebene = Range(„D“ & i)
Next i

Set gApp = CreateObject(„AcroExch.App“)
Set gAvDoc = CreateObject(„AcroExch.AVDoc“)
If gAvDoc.Open(gPDFPath, „“) Then
Set PDDoc = gAvDoc.GetPDDoc()
Set jso = PDDoc.GetJSObject
Set BMR = jso.BookmarkRoot
j = 1
BMR.createChild LESE(1).Eintrag, "this.pageNum= " & LESE(1).Seite, 0
bmc = BMR.Children
Set oBMC = bmc(0)
For i = 2 To Anzahl - 1
If LESE(i).Ebene = 0 Then
BMR.createChild LESE(i).Eintrag, "this.pageNum= " & LESE(i).Seite, j
bmc = BMR.Children
Set oBMC = bmc(LESE(i).Gliederung)
Else
oBMC.createChild LESE(i).Eintrag, "this.pageNum= " & LESE(i).Seite, j
If LESE(i).Gliederung <> LESE(i + 1).Gliederung Then
bmc = oBMC.Children
End If
End If
j = j + 1
Next i
End If
n = PDDoc.Save(PDSaveFull, Wertekopie & „.pdf“)
PDDoc.Close
gApp.Exit

Set gApp = Nothing
Set gAvDoc = Nothing
Set PDDoc = Nothing
Set jso = Nothing

Vielen Dank im Voraus.

#2

Kein Problem ist zu komplex für eine Lösung in VBA innerhalb von Excel.

Wie wäre es, das Dokument einfach in Adobe zu öffnen und das dort mit 2 Klicks einzustellen?

Wenn das nicht geht, weil das eine unternehmenskritische Automatisierungsmaßnahme sein soll, dann nimm bitte eine Programmiersprache, die für unternehmenskritische Automatisierungsmaßnahmen taugt. VBA tut das eindeutig nicht.

Über deine Variablenname und das komplette Fehlen von Quelltextkommentaren werde ich mich heute einfach mal nicht äußern.

#3

Danke, auch wenn die Antwort an der Fragestellung vorbei ging.

Ich habe inzwischen eine Lösung gefunden und es war, wie schon vermutet, nur eine einzige Zeile (siehe unten in Fett).

gPDFPath = „C:\Test\Test.pdf“
Worksheets(„Lesezeichen“).Activate
Anzahl = ThisWorkbook.Sheets(„Lesezeichen“).UsedRange.Rows.Count
ReDim LESE(Anzahl)
For i = 2 To Anzahl
LESE(i - 1).Eintrag = Range(„A“ & i)
LESE(i - 1).Seite = Range(„B“ & i)
LESE(i - 1).Gliederung = Range(„C“ & i)
LESE(i - 1).Ebene = Range(„D“ & i)
Next i

Set gApp = CreateObject(„AcroExch.App“)
Set gAvDoc = CreateObject(„AcroExch.AVDoc“)
If gAvDoc.Open(gPDFPath, „“) Then
Set PDDoc = gAvDoc.GetPDDoc()
Set jso = PDDoc.GetJSObject
Set BMR = jso.BookmarkRoot
j = 1
BMR.createChild LESE(1).Eintrag, "this.pageNum= " & LESE(1).Seite, 0
bmc = BMR.Children
Set oBMC = bmc(0)
For i = 2 To Anzahl - 1
If LESE(i).Ebene = 0 Then
BMR.createChild LESE(i).Eintrag, "this.pageNum= " & LESE(i).Seite, j
bmc = BMR.Children
Set oBMC = bmc(LESE(i).Gliederung)
Else
oBMC.createChild LESE(i).Eintrag, "this.pageNum= " & LESE(i).Seite, j
If LESE(i).Gliederung <> LESE(i + 1).Gliederung Then
bmc = oBMC.Children
End If
End If
j = j + 1
Next i
End If

n = PDDoc.SetPageMode(3)

n = PDDoc.Save(PDSaveFull, Wertekopie & „.pdf“)
PDDoc.Close
gApp.Exit

Set gApp = Nothing
Set gAvDoc = Nothing
Set PDDoc = Nothing
Set jso = Nothing

#4

na prima. Wenn du das nächste Mal noch den Button für die Einfügung von Quelltext findest, sind wir ja alle glücklich.

Danke auch für den Downvote.