Ouvrir fichier pdf depuis une macro sans hyperlink
Bonjour,
Je travaille sur un fichier "workflow" de validation de commandes à trois niveaux. Le principe :
- Le valideur niveau 1 renseigne tous les champs (société, intitulé travaux, montant, etc.) et va chercher le devis préalablement enregistré (signé électroniquement en bon pour accord). Un lien avec le chemin d'accès complet du devis est inséré dans le tableau. Un mail est envoyé automatiquement au responsable du N1 avec le formulaire de demande de commande et le devis en PJ, ainsi qu'un lien vers le fichier de validation des commandes.
- Le valideur niveau 2 ouvre le fichier, appuie sur un bouton validation N2, renseigne le numéro de format de commande qu'il veut valider. Le fichier PDF s'ouvre.
C'est ici que j'ai un problème. J'utilise actuellement la méthode Follow Hyperlink, le fichier s'ouvre sans pb. Par contre, le niveau 2 doit apposer sa signature électronique et enregistrer le devis (sous le même nom) à son tour.
Le problème est que nous recevons un message disant que le fichier est ouvert dans une autre application (dû au fait je pense qu'on l'a appelé depuis Excel), et je ne peux donc pas écraser le fichier.
L'idée serait donc de remplacer la méthode Hyperlink par une fonction Shell, qui exécuterait acrobat Reader et ouvrirait le fichier (dont je connais le nom et le chemin d'accès) comme si je passais par l'explorateur Windows. Je pourrais alors contresigner.
Je ne peux pas joindre le fichier complet pour des raisons de confidentialité mais voici le code de ce module, avec en rouge la partie que je souhaite modifier :
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
| Sub VALID_N2()
'renseigner le numéro de format de commande
Dim numfc As String
numfc = InputBox("Quel format de commande voulez-vous valider ?", "Titre")
If resultat <> "" Then
MsgBox numfc
End If
Sheets("Format commande type 2013").Activate
Range("T1").Value = numfc
'ouvrir le devis concerné
Dim fichierdevis As Integer
Sheets("ETAT DES OS").Activate
With Sheets("ETAT DES OS").Range("A1:A5000")
Range("A1:A5000").Select
numligne = Selection.Find(numfc, , LookIn:=xlValues).Row
End With
Application.ThisWorkbook.FollowHyperlink (Range("AF" & numligne).Value)
'message d'attente
MsgBox "Avant de cliquer sur OK, veuillez signer, enregistrer et fermer le devis"
' Imprimer PDF
Sheets("Format commande type 2013").Activate
Chemin = "R:\SIAL\DIL\sv_emti\INDICATEURS\01_BUDGET\02_Commandes_factures_Pole_13\Test\Valid Niv_2\"
NomFichier = Range("T1") & " - " & Range("F24") & " - " & Range("F37")
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin & NomFichier, Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
'préparation PJ devis
Sheets("ETAT DES OS").Activate
Dim stfile As String
stfile = Cells(numligne, "AF").Value
' Envoi Mail
Set olApp = CreateObject("Outlook.application")
Set m = olApp.CreateItem(olMailItem)
With m
Dim strbody As String
Dim corpsmessage As String
.Subject = "Format de commande " & NomFichier
.Body = "Bonjour," & vbCrLf & vbCrLf & "Ci-joint le format de commande " & Range("T1").Value & vbCrLf & "" & vbCrLf & Range("F24") & " - " & Range("F37") & " - " & Range("f49") & vbCrLf & vbCrLf & "file://R:\SIAL\DIL\sv_emti\INDICATEURS\01_BUDGET\02_Commandes_factures_Pole_13\OS_POLE_13_workflow.xlsm" & vbCrLf & "" & vbCrLf & "Cordialement"
.To = "XX" & ";" & "XX"
.Cc = "XX"
.Attachments.Add Chemin & NomFichier & ".pdf"
.Attachments.Add stfile
.display True
End With
'Validation niveau 2
Sheets("ETAT DES OS").Activate
Cells(numligne, "AD").Value = "OUI"
End Sub |
Merci de vos lumières, là je suis coincé !
