Sélectionner puis Copier fichier avec reprise du lien

Bonsoir,

Ci-dessous un bout de code permettant de sélectionner un fichier image, d'en insérer uniquement le nom avec un lien avec hypertexte.

Je cherche à modifier le code pour que le fichier soit d'abord copié dans un autre dossier prédéfini et que ce soit lui qui soit ensuite insérer etc...

J'ai essayé avec File Copy mais je n'y arrive pas.

Merci de votre aide

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) 

Dim image As Shape
Dim picToOpen As String

On Error Resume Next

If Not Application.Intersect(Target, Range("AE7:AM45")) Is Nothing Then
picToOpen = Application.GetOpenFilename("Pics (*.jpg;*.gif;*.png;*.jpeg), *.jpg;*.gif;*.png;*.jpeg")
'ActiveSheet.Pictures.Insert(picToOpen).Select
FileCopy ActiveSheet.Pictures.picToOpen.Select "C:\Classeur.jpeg"
Target1 = Mid(picToOpen, InStrRev(picToOpen, "\") + 1)
Target = Left(Target1, InStr(Target1, ".") - 1)
ActiveSheet.Hyperlinks.Add Anchor:=Target, Address:=picToOpen
ActiveSheet.Pictures(5).Delete
Cancel = True
End If

End Sub

Bonsoir,

FileCopy copie un fichier, pas l'image que tu insères !

FileCopy cheminetnomfichierSource cheminetnomfichierDestination

Bonjour

Donc si je comprend bien, il faut plutôt que je fasse un Save avec l'Application.GetOpenFilename et ensuite que j'insère l'image ?

Cdt

Je ne vois pas ce que tu comprends ou pas !

Save est une méthode qui concerne l'objet Workbook... En l'évoquant tu te places donc dans Excel !

Or copier un fichier situé dans un dossier dans un autre, cela ne se passe pas dans Excel ! On est dans le systéme de fichiers de ton ordinateur, et tu utilises une instruction ne référant aucunement à Excel ou l'un de ses composants !

Cordialement.

Voici la solution....

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) 'Insertion image

Dim image As Shape
Dim picToOpen As String

On Error Resume Next

If Not Application.Intersect(Target, Range("AE7:AM45")) Is Nothing Then
Fichier = Application.GetOpenFilename()

If Fichier <> False Then
   NomFichier = Mid(Fichier, InStrRev(Fichier, "."))
   date_du_jour = Format(Now, "ddhhnnss")
   FileCopy Fichier, ThisWorkbook.Path & "\Photo\" & Worksheets("Fiche").Range("AH3") & date_du_jour & NomFichier
   Adr = ThisWorkbook.Path & "\Photo\" & Worksheets("Fiche").Range("AH3") & date_du_jour & NomFichier
   Target = Worksheets("Fiche").Range("AH3") & date_du_jour
   ActiveSheet.Hyperlinks.Add Anchor:=Target, Address:=Adr
End If

Cancel = True
End If
End Sub