Lien hypertext VBA

bonjour a tous

voici un code vba qui me serre a archiver des bon de commande (enregistre dans un nouveau classeur pour chacun des bon et un recap avec date, numéro, nom et tarifs dans le "classeur bon de commande"

voici mon problème

le numéro un en faite un lien hypertext qui ne fonction pas, , quand je clique sur le lien message "impossible d'ouvrir ce fichier spécifique, je pense que le problème vient de "monfichier"

je ne peut vous donner le fichier car il est trop volumineux

merci à tous de votre aide.de mon cote je cherche a vous envoyer un plus petit fichier

.Hyperlinks.Add .Cells(ligne, 2), chemin & "\" & nomfichier

chemin = "D:\entrep\Bon de commande\"
nomfichier = ActiveSheet.Range("F4") & Format(Now(), "-mmmm" & "-yyyy") & "-F" & Format(ActiveSheet.Range("C7"), "0000") & "-" 

Sub Archiverbis()
Dim extension As String
Application.ScreenUpdating = False
ThisWorkbook.ActiveSheet.Copy
extension = ".xls"
'chemin = "D:\entrep\Bon de commande\"
'nomfichier = ActiveSheet.Range("F4") & Format(Now(), "-mmmm" & "-yyyy") & "-F" & Format(ActiveSheet.Range("C7"), "0000") & "-" & extension
ActiveSheet.DrawingObjects(1).Delete
ActiveWorkbook.SaveAs Filename:= _
    "D:\entrep\Bon de commande\" & ActiveSheet.Range("F4") _
    & "-Bon-" & Range("F4") & extension
Call RecapBondecommande
ActiveWorkbook.Close
End Sub

Sub RecapBondecommande()

Dim ligne As Integer
Dim feuilleactive As String
Application.ScreenUpdating = False
feuille = ThisWorkbook.Sheets("RecapBondecommande").Name
feuilleactive = ActiveSheet.Name

On Error Resume Next
With ThisWorkbook.Sheets(feuille)
    ligne = .Range("A65536").End(xlUp).Row + 1
    If ActiveSheet.Name = "Bon de commande" Then
        .Cells(ligne, 1) = Sheets(feuilleactive).Range("E1").Value
        .Cells(ligne, 2) = Format(Sheets(feuilleactive).Range("C6"), "0000")

        .Hyperlinks.Add .Cells(ligne, 2), chemin & "\" & nomfichier

        .Cells(ligne, 3) = Sheets(feuilleactive).Range("F4")
        .Cells(ligne, 4) = Sheets(feuilleactive).Range("A39")
        .Cells(ligne, 5) = Sheets(feuilleactive).Range("G11")
        ActiveWorkbook.Save
        MsgBox "Vos Nouvelles Données sont Enregistrées"
    End If
'Call EliminerDoublons
End With
Workbooks(2).Activate
End Sub

Bonjour Pascal,

Déjà, dans le premier code que tu donnes, l'ordonnancement de l'exécution n'est pas bon.

Tu crées ton lien hypertexte avant d'avoir déterminé les variables chemin et nomFichier !

Je te laisse corriger.

bonjour

merci erreur de debutant

merci a +