shell function bei Klick ausführen

[markusf1895]

Code:

Function OpenPDF(sFile As String, _
                 Optional page, _
                 Optional zoom, _
                 Optional pagemode, _
                 Optional scrollbar, _
                 Optional toolbar, _
                 Optional statusbar, _
                 Optional messages, _
                 Optional navpanes)
    On Error GoTo Error_Handler
    Dim WSHShell        As Object
    Dim sAcrobatPath    As String
    Dim sParameters     As String
    Dim sCmd            As String
    Dim rng As Range
    Set rng = Application.Caller
 
    'Determine the path to Acrobat Reader
    Set WSHShell = CreateObject("Wscript.Shell")
    sAcrobatPath = WSHShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\AcroRd32.exe\")
 
    'Build our parameters
    If Not IsMissing(page) Then
        If Len(sParameters) = 0 Then
            sParameters = "page=" & page
        Else
            sParameters = sParameters & "&" & "page=" & page
        End If
    End If
    If Not IsMissing(zoom) Then
        If Len(sParameters) = 0 Then
            sParameters = "zoom=" & zoom
        Else
            sParameters = sParameters & "&" & "zoom=" & zoom
        End If
    End If
    If Not IsMissing(pagemode) Then
        If Len(sParameters) = 0 Then
            sParameters = "pagemode=" & pagemode
        Else
            sParameters = sParameters & "&" & "pagemode=" & pagemode
        End If
    End If
    If Not IsMissing(scrollbar) Then
        If Len(sParameters) = 0 Then
            sParameters = "scrollbar=" & scrollbar
        Else
            sParameters = sParameters & "&" & "scrollbar=" & scrollbar
        End If
    End If
    If Not IsMissing(toolbar) Then
        If Len(sParameters) = 0 Then
            sParameters = "toolbar=" & toolbar
        Else
            sParameters = sParameters & "&" & "toolbar=" & toolbar
        End If
    End If
    If Not IsMissing(statusbar) Then
        If Len(sParameters) = 0 Then
            sParameters = "statusbar=" & statusbar
        Else
            sParameters = sParameters & "&" & "statusbar=" & statusbar
        End If
    End If
    If Not IsMissing(messages) Then
        If Len(sParameters) = 0 Then
            sParameters = "messages=" & messages
        Else
            sParameters = sParameters & "&" & "messages=" & messages
        End If
    End If
    If Not IsMissing(navpanes) Then
        If Len(sParameters) = 0 Then
            sParameters = "navpanes=" & navpanes
        Else
            sParameters = sParameters & "&" & "navpanes=" & navpanes
        End If
    End If
    'Open our PDF
    If Len(sParameters) = 0 Then 'No parameters
        Shell sAcrobatPath & " " & Chr(34) & sFile & Chr(34), vbNormalFocus
    Else 'Parameters
        'Open the file using Shell (no prompt)
        sCmd = sAcrobatPath & " /A " & Chr(34) & sParameters & Chr(34) & " " & Chr(34) & sFile & Chr(34)
        Shell sCmd, vbNormalFocus
        '        'Open the file using FollowHyperlink (user will get prompts)
        '        sCmd = Replace(sFile, "\", "/") & "#" & sParameters
        '        Application.FollowHyperlink sCmd
    End If
    OpenPDF = "Seite " & page
    
 

Error_Handler_Exit:
    On Error Resume Next
    Set WSHShell = Nothing
    Exit Function
 
Error_Handler:
    MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: OpenPDF" & vbCrLf & _
           "Error Description: " & Err.Description, _
           vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Function

Input Zelle:
=OpenPDF("H:\Ersatzteilkatalog.pdf";10)
do: öffnet Ersatzteilkatalog.pdf auf Seite 10

Hallo,

hab zu voriges kopiert und überarbeitet um pdf-Dateien auf einer bestimmen Seite zu öffnen.
wollte jetzt noch das sich die pdf beim klick öffnet, ähnlich wie ein Hyperlink.
Arbeite mit Office 365, also die Version aus dem Jahr 2016

komme einfach nicht weiter und erbitte Hilfestellung

[Storax]

Der Code ist von hier
Vielleicht reicht das

Update Um das zu erreichen,

wollte jetzt noch das sich die pdf beim klick öffnet, ähnlich wie ein Hyperlink.

fügst Du einfach einen Hyperlink in die Zelle mit dem Dateinamen ein. Der Hyperlink zeigt auf die Zelle selber und fügst entsprechenden Code in das FollowHyperlink Ereignis ein,
z.B.

PHP-Code:

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    OpenPDF Target.Parent.Value, 20
End Sub 


[markusf1895]

nun öffnet er es nicht auf der zuvor bestimmten Seite

[Storax]

[Ironie an] Du bist ja echt recht ausführlich in Deinen Posts. [Ironie aus]
Bei mir funktioniert alles, so wie ich mir das vorstelle. Woher soll ich wissen, wie Du meine Tipps umgesetzt hast.
Das ist kein Copy&Paste Code ...

[markusf1895]

[Ironie an] und deine Anleitung ist auch so unglaublich präzise, Beispiel der Anwendung war nicht möglich? [Ironie aus]

mein neuer PHP-Code:

Code:

'für den Botton
Sub linkpdfpage()
Worksheets("Tabelle1").Activate
Shell ("C:\Program Files\Internet Explorer\iexplore.exe " + ActiveCell.Value)
End Sub

'---------------------------------------------------------------------------------------
' Procedure : OpenPDF
' Author    : Daniel Pineault, CARDA Consultants Inc.
' changer   : Markus Sobotta, Hach Lange GmbH
' Website   : [url=http://www.cardaconsultants.com/]http://www.cardaconsultants.com[/url]
' Purpose   : Open a PDF on a specific page
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
' Reference : [url=http://www.adobe.com/content/dam/Adobe/en/devnet/acrobat/pdfs/pdf_open_parameters.pdf]http://www.adobe.com/content/dam/Adobe/en/devnet/acrobat/pdfs/pdf_open_parameters.pdf[/url]
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sFile     : Fully qualified pathe and filename, including extension, of the PDF to
'             open.
' page      : Page number to open the document at
' zoom      : Numerical value representing a zoom factor; 100=100%, 65=65%, ...
' pagemode  : Displays bookmarks or thumbnails; bookmarks, thumbs, none
' scrollbar : Turns scrollbars on or off; 1=Turn on, 0=Turn off
' toolbar   : Turns the toolbar on or off; 1=Turn on, 0=Turn off
' statusbar : Turns the status bar on or off; 1=Turn on, 0=Turn off
' messages  : Turns the document message bar on or off; 1=Turn on, 0=Turn off
' navpanes  : Turns the navigation panes and tabs on or off; 1=Turn on, 0=Turn off
'
' Usage:
' ~~~~~~
' OpenPDF "C:\Users\Daniel\Documents\Test\Test.pdf",3,,"none",1,0,0,0,0
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2013-Dec-04                 Initial Release
' 1         2013-Dec-04                 More advanced options added
'---------------------------------------------------------------------------------------
Function OpenPDF(sFile As String, _
                 Optional page, _
                 Optional zoom, _
                 Optional pagemode, _
                 Optional scrollbar, _
                 Optional toolbar, _
                 Optional statusbar, _
                 Optional messages, _
                 Optional navpanes)
    On Error GoTo Error_Handler
    Dim WSHShell        As Object
    Dim sAcrobatPath    As String
    Dim sParameters     As String
    Dim sCmd            As String
    Dim rng As Range
    Set rng = Application.Caller
 
    'Determine the path to Acrobat Reader
    Set WSHShell = CreateObject("Wscript.Shell")
    sAcrobatPath = WSHShell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\AcroRd32.exe\")
 
    'Build our parameters
    If Not IsMissing(page) Then
        If Len(sParameters) = 0 Then
            sParameters = "page=" & page
        Else
            sParameters = sParameters & "&" & "page=" & page
        End If
    End If
    If Not IsMissing(zoom) Then
        If Len(sParameters) = 0 Then
            sParameters = "zoom=" & zoom
        Else
            sParameters = sParameters & "&" & "zoom=" & zoom
        End If
    End If
    If Not IsMissing(pagemode) Then
        If Len(sParameters) = 0 Then
            sParameters = "pagemode=" & pagemode
        Else
            sParameters = sParameters & "&" & "pagemode=" & pagemode
        End If
    End If
    If Not IsMissing(scrollbar) Then
        If Len(sParameters) = 0 Then
            sParameters = "scrollbar=" & scrollbar
        Else
            sParameters = sParameters & "&" & "scrollbar=" & scrollbar
        End If
    End If
    If Not IsMissing(toolbar) Then
        If Len(sParameters) = 0 Then
            sParameters = "toolbar=" & toolbar
        Else
            sParameters = sParameters & "&" & "toolbar=" & toolbar
        End If
    End If
    If Not IsMissing(statusbar) Then
        If Len(sParameters) = 0 Then
            sParameters = "statusbar=" & statusbar
        Else
            sParameters = sParameters & "&" & "statusbar=" & statusbar
        End If
    End If
    If Not IsMissing(messages) Then
        If Len(sParameters) = 0 Then
            sParameters = "messages=" & messages
        Else
            sParameters = sParameters & "&" & "messages=" & messages
        End If
    End If
    If Not IsMissing(navpanes) Then
        If Len(sParameters) = 0 Then
            sParameters = "navpanes=" & navpanes
        Else
            sParameters = sParameters & "&" & "navpanes=" & navpanes
        End If
    End If
    'Open our PDF
    If Len(sParameters) = 0 Then 'No parameters
        Shell sAcrobatPath & " " & Chr(34) & sFile & Chr(34), vbNormalFocus
    Else 'Parameters
        'Open the file using Shell (no prompt)
        sCmd = sAcrobatPath & " /A " & Chr(34) & sParameters & Chr(34) & " " & Chr(34) & sFile & Chr(34)
        Shell sCmd, vbNormalFocus
        '        'Open the file using FollowHyperlink (user will get prompts)
        '        sCmd = Replace(sFile, "\", "/") & "#" & sParameters
        '        Application.FollowHyperlink sCmd
    End If
    OpenPDF = "Seite " & page
    
 

Error_Handler_Exit:
    On Error Resume Next
    Set WSHShell = Nothing
    Exit Function
 
Error_Handler:
    MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: OpenPDF" & vbCrLf & _
           "Error Description: " & Err.Description, _
           vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Function
'_____________________________________________________________
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
    OpenPDF Target.Parent.Value, 20
End Sub

und hab das nun gemacht: =HYPERLINK("Ersatzteilkatalog_KLD_1042.pdf";"anzeigename")
naja, zudem ist mir nicht bewusst in wie fern dies meine Funktion nutzt.


Danke für die Mühe

[WillWissen]

Hallo Markus,

wenn du, wie in diesen Thread bereits zweimal, längere Makros postest, setzte diese doch bitte wegen der besseren Lesbarkeit in Codetags. Dazu musst du nur den geposteten Code markieren und in der zweiten Iconleiste den 5. Schalter von rechts betätigen.

[markusf1895]

hasst du eine Lösung für mein Problem, Storax?

[Storax]

So, so, ein Copy & Paste Progger, der sich beschwert. Etwas Transferleistung hatte ich erwartet ...
Meine Beschreibung war quasi der "Challenging Path", quasi für den fachkundingen Experten.

[markusf1895]

Naja für eine Leihe, mit Vorkenntnissen aus der Schulzeit, ist XML mega komplex.
Arbeite eigentlich mit C++ or Java.
Aber der Aufbau bei VBA und wo ich was hin zu schreiben hab, wirft mich aus der Bahn

Trotzdem danke, es hat immerhin geklappt, auch wenn nicht wie ursprünglich angedacht.

[Storax]

Naja für eine Leihe, mit Vorkenntnissen aus der Schulzeit, ist XML mega komplex.
Arbeite eigentlich mit C++ or Java.
Aber der Aufbau bei VBA und wo ich was hin zu schreiben hab, wirft mich aus der Bahn

Trotzdem danke, es hat immerhin geklappt, auch wenn nicht wie ursprünglich angedacht.

Für einen (echten!) C++ oder Java Programmierer ist VBA kein Problem.
Programmieren hat nichts mit der Programmiersprache zu tun.

Wie war es denn ursprünglich gedacht? Wenn Du alles in einer Zelle haben willlst, ist das natürlich kein Problem.
Wenn in der Zelle z.B. PDF_Dateiname#page=10 stehen soll und das Dokument auf Seite 10 geöffnet werden soll,
ist das ziemlich einfach machbar. Ran an die Tasten ... das kriegt ein C++ Progger hin.