Wie kann ich aus Excel eine .pdf Datei mit Adobe Reader auf mehreren Seiten (um einzelne Seiten zu vergleichen) gleichzeitig öffnen?
Hallo,
das kann man z.B. mit dem folgenden VBA-Programm machen.
Es öffnet 2 Seiten, um mehr Seiten zu öffnen, kann man das Prinzip erneut mehrmals anwenden.
Sub Zwei_Seiten_eines_PDFs_öffnen()
Dim dateiPDF As String
Dim dateiPDF_Temp As String
Dim filPDF As File
Dim fso As FileSystemObject
Dim pfadDateiPDF As String
Dim pfadDateiPDF_Temp As String
Dim pfadPDF As String
Dim Seite_1 As Long
Dim Seite_2 As Long
Dim strAcroRd As String
´ 1. Seite aufschlagen
Seite_1 = 6
pfadPDF = ThisWorkbook.Path & „“
dateiPDF = „Grundeinstellungen_Excel_VBA_2016.pdf“
pfadDateiPDF = pfadPDF & dateiPDF
Set fso = New FileSystemObject
If Not fso.FileExists(pfadDateiPDF) Then
MsgBox Prompt:=“Die Datei“ & vbNewLine & pfadDateiPDF & vbNewLine & _
„existiert nicht!“, _
Buttons:=vbCritical
GoTo Ende
End If
dateiPDF_Temp = Left$(dateiPDF, Len(dateiPDF) – 4) & „_TEMP.pdf“
pfadDateiPDF_Temp = pfadPDF & dateiPDF_Temp
´ Adobe Reader schließen, anderenfalls gibt es Probleme beim Copy
Adobe_Reader_schließen
Set filPDF = fso.GetFile(pfadDateiPDF)
filPDF.Copy Destination:=pfadDateiPDF_Temp, _
Overwritefiles:=True
strAcroRd = Space$(260)
FindExecutable pfadDateiPDF_Temp, vbNullString, strAcroRd
strAcroRd = Left$(strAcroRd, InStr(strAcroRd, vbNullChar) – 1)
Shell „“““ & strAcroRd & „““ /A page=“ & Seite_1 & “ „““ & pfadDateiPDF_Temp & „“““, vbMaximizedFocus
´ 2. Seite aufschlagen
Seite_2 = 3
strAcroRd = Space$(260)
FindExecutable pfadDateiPDF, vbNullString, strAcroRd
strAcroRd = Left$(strAcroRd, InStr(strAcroRd, vbNullChar) – 1)
Shell „“““ & strAcroRd & „““ /A page=“ & Seite_2 & “ „““ & pfadDateiPDF & „“““, vbMaximizedFocus
Ende:
Set fso = Nothing
End Sub
Sub Adobe_Reader_schließen()
Dim objProcess As Object
Dim objProcessList As Object
Dim objWMI As Object
Set objWMI = GetObject(„winmgmts:{impersonationLevel=impersonate}!\.
ootcimv2“)
Set objProcessList = objWMI.ExecQuery(„Select * from Win32_Process WHERE Name LIKE ´Acrobat%´“)
On Error Resume Next
For Each objProcess In objProcessList
objProcess.Terminate (0)
Next
Set objProcessList = Nothing
Set objWMI = Nothing
End Sub
Viele Grüße
Dieter Klemke