XL 2021 Ouverture d'un PDF à l'aide d'un bouton clic et pour multi utilisateur PC

[AugusteP]

Bonjour tout le monde. Je cherche une codification VBA afin d'ouvrir un PDF contenu dans sous-dossier qui est lui-même contenu dans un dossier.
Pour être plus clair (je l'espère !), le dossier de base se nomme Super Drive, il est situé sur le bureau et le sous-dossier dans ce dernier. Le PDF quant à lui est enregisté dans ce sous-dossier. J'ai essayé certaines codifications mais cela ne me permet pas d'être utilisé sur différents PC.

Ci-dessous les lignes de code de l'application qui peut éventuellement aider à m'apporter une solution. Merci !

Private Sub EnregistrementBCde_Click()

'Déclaration des variables

Dim Dossier     As String

Dim SubDir      As Variant

Dim Fso         As Object

    If Me.LbNomClient = "" Then

        Me.LbNomClient.SetFocus

    Else

        ' Création des subdirectories si nécessaire

        Dossier = CreateObject("WScript.Shell").specialFolders("Desktop")

        Set Fso = CreateObject("Scripting.FileSystemObject")

            For Each SubDir In Array("Super Drive", "Commande client", Me.LbNomClient)

                Dossier = Dossier & "\" & SubDir

                If Not Fso.FolderExists(Dossier) Then Fso.CreateFolder Dossier

            Next

        Set Fso = Nothing

       ' Sauvegarde du fichier au format pdf .........................

        Commande = " Traitement Commande N° " & Me.Txtnumcde & " du " & Format(Date, "dd-mm-yyyy") & ".pdf" '...............Références de la commande à sauvegarder

        Sheets("Traitement Cde").ExportAsFixedFormat Type:=xlTypePDF, _

            Filename:=Dossier & "\" & Commande, _

            Quality:=xlQualityStandard, IncludeDocProperties:=True, OpenAfterPublish:=False

    End If

Exit Sub



'Le traitement de l'erreur se p1ace en dessous d'un exit sub juste avant le end sub

1:

MsgBox "Erreur de traitement, sortie de formulaire"

Application.ScreenUpdating = True

End Sub

Sub test_repertoire(CheminDossier As String)

'

'*************************************************************************************

'   fonctionne en lien avec la procédure Private Sub EnregistrementBCde_Click()          *

'*************************************************************************************

Dim fs As Object

Set fs = CreateObject("Scripting.FileSystemObject") '................instanciation de la variable fs

If fs.FolderExists(CheminDossier) Then '.............................le repertoire existe donc rien à faire

Else: fs.CreateFolder CheminDossier  '...................................le repertoire n'existe pas donc on le créait

End If

Set fs = Nothing '...................................................vide l'instanciation fs

End Sub

[/CODE]

 

[kiki29]

Salut, à télécharger puis consulter : Liste Contributions PDF
un coup de Notepad++ TextFX Delete Blank Lines sur ton code ne ferait pas de mal.

 

[AugusteP]

JE joint ci-dessous le début de code qui me permet d'ouvrir il me semble le contenu du bureau mais qui ne me permet pas d'aller plus loin

.Private Sub commandbuttton_click()

Dim filepath As String

With Application.FileDialog(msoFileDialogFilePicker)
.Title = "selectionner un répertoire"
.Show

If .SelectedItems.Count > 0 Then
filepath = .SelectedItems(1)
Workbooks.Open (filepath & "\Commande_client")

End If
End With
End Sub

 

[AugusteP]

La solution m'est apportée par SALMANASARD. Merci à lui

Sub Ouvrir_PDF()

    ActiveWorkbook.FollowHyperlink ActiveWorkbook.Path & "\Chemin du sous répertoire\Le fichier.pdf"
'le chemin final sera à renseigner, ainsi que le nom du Pdf à ouvrir. ;)
End Su