Ouvrir une copie d'un fichier

Troudz

XLDnaute Occasionnel
Bonjour tout le monde,

J'ai un classeur qui contient de nombreux liens vers d'autres documents de tout type (xls, doc, pdf...). Un simple clic sur une image et une macro ouvre le document afférent. Jusque là, pas de soucis.

Là où ça se corse, c'est que les utilisateurs ont tendance (soit disant par inadvertance...) à modifier ces documents.
Je voudrais donc adapter ma macro pour que :
- soit elle ouvre une simple copie du document afférent
- soit elle ouvre le document en lecture seule

J'ai réussi l'adapter pour l'ouverture des document Word et Excel mais je ne sais pas comment faire pour les pdf (et autres documents "non Office").

Est - ce réalisable ? Auriez vous une idée ?

Je vous remercie par avance.

Ma macro en question :

Code:
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Sub OuvrirFichier(Fichier As String)
    Select Case ExtraireExtension(Fichier)
    Case ".xl", ".xls", ".xlt", ".xla", ".xlm", ".xlc", ".xlw"
        Set NouvelAppli = CreateObject("Excel.Application")
        NouvelAppli.Workbooks.Add Template:=Fichier
        '.Open Fichier
        NouvelAppli.Visible = True
    Case ".doc", ".dot"
        Set NouvelAppli = CreateObject("Word.Application")
        NouvelAppli.Documents.Add Template:=Fichier
        NouvelAppli.Visible = True
    Case Else
        Call ShellExecute(0, "Open", Fichier, "", "", 1)
    End Select
End Sub
Public Function ExtraireExtension(ByVal sFullPath As String) As String
    Dim sName As String
    sName = ExtraireNomFichier(sFullPath)
    If InStr(sName, ".") = 0 Then
        ExtraireExtension = ""
    Else
        ExtraireExtension = Mid(sName, InStrRev(sName, "."))
    End If
End Function
Public Function ExtraireNomFichier(ByVal sFullPath2 As String) As String
    If InStr(sFullPath2, "\") = 0 Or Right(sFullPath2, 1) = "\" Then
        ExtraireNomFichier = ""
        Exit Function
    End If
    ExtraireNomFichier = Mid(sFullPath2, InStrRev(sFullPath2, "\") + 1)
End Function
 

Discussions similaires

Statistiques des forums

Discussions
312 113
Messages
2 085 426
Membres
102 887
dernier inscrit
MarcVeretz