Bonjour à toutes et à tous,

Je n'arrive pas à écrire un bout de code pour créer un lien hypertexte
e suis allé voir les faqs et j'ai fait une recherche sur le forum j'ai essayé de ré appliquer ce que j'y ai vu en fonction de mon cas mais ça veut pas...

J'explique mon Pb. J'ai un devis que j'enregistre dans un répertoire windows, et en plus j'archive quelques éléments de ce devis (NumFact, Date de fact,etc...)sur un classeur excel(Devisprovisoire.xlsx, feuille DP!).

J'essaye de faire en sorte qu'a chaque sauvegarde un lien hypertexte se créé automatiquement du NumFact colonne A de la feuille archivée DP au devis enregistré dans windows

Voici le code que j'ai écrit et évidemment il ne marche pas si un oeil expert pouvait m'aiguiller merci d'avance.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
Sub Hyperlink()
 
Dim Rep As String, NumFact As String, Client As String
Dim Macible As String
Dim filename As String
Dim objLink As Hyperlink
 
Application.ScreenUpdating = False
'Initialisation variables
Rep = Worksheets("Menu").Range("C9").Value
With Worksheets("Devis")
    NumFact = .Range("F19").Value
    Client = .Range("J13").Value
End With
Set filename = Rep & NumFact & " " & Client & ".xls"
Set address = filename
Set Macible = Columns(1).Find(What:=NumFact, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=True)
Set objLink = ActiveSheet.Hyperlinks.Add(Macible, objLink.address)
With objLink
objLink.address = filename
Follow NewWindow:=True
End With
 
End Sub
J'obtiens une erreur qui me dit qu'il ne reconnait pas l'objet filename. mais ça ne me parle pas beaucoup...
je mets le code de sauvegarde dans lequel cette macro doit être intégrée et le classeur d'archivage dans lequel se situe le NumFact lien permettant d'ouvrir le devis sauvegardé.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
Sub A_Devis()
 
Dim Rep As String, NumFact As String, Client As String, Tb() As String
Dim Sh As Worksheet
Dim j As Byte
 
Application.ScreenUpdating = False
'Initialisation variables
Rep = Worksheets("Menu").Range("C9").Value
With Worksheets("Devis")
    NumFact = .Range("F19").Value
    Client = .Range("J13").Value
End With
 
'Recherche des feuilles à enregistrer
ReDim Tb(0)
Tb(0) = "Devis"
For Each Sh In ThisWorkbook.Worksheets
    If InStr(Sh.Name, "Détail") > 0 Then
        j = j + 1
        ReDim Preserve Tb(0 To j)
        Tb(j) = Sh.Name
    End If
Next Sh
 
'enregistrement des feuilles trouvées
Worksheets(Tb).Copy
With ActiveWorkbook
    For Each Sh In .Worksheets
        Sh.UsedRange.Value = Sh.UsedRange.Value
    Next Sh
    Application.DisplayAlerts = False
    .SaveAs filename:=Rep & NumFact & " " & Client & ".xls", FileFormat:=xlExcel8
    .Close False
    Application.DisplayAlerts = True
 
 
    'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
'Range("J10").Value = "Duplicata Devis"
 
'ActiveWindow.SelectedSheets.PrintOut Copies:=Nb_Ex - 1, Collate:=True
'Range("K10").Value = "Devis"
 
End With
 
Call A_infosdevis
 
ThisWorkbook.Activate
 
    Sheets("Menu").Activate
    Range("C10").Value = Range("C10").Value + 1
 
 
 
MsgBox "Le devis n° " & Num_Fact & vbCrLf & " pour le client " & Nom_client & vbCrLf & " a bien été archivé.", vbInformation + vbOKOnly, "Archivage devis"
 
 
End Sub
 
Sub A_infosdevis()
 
Num_Fact = Range("F19").Value
    Date_Fact = Range("L5").Value
        Nom_client = Range("J13").Value
            Montant_DevisHT = Range("M57").Value
                Montant_DevisTTC = Range("M59").Value
                Indice_Devis = Range("G19").Value
 
Application.Workbooks.Open "f:\Atest\Devisprovisoire.xlsx"
 
Sheets("DP").Activate
    Range("A1").Select
If Range("A2").Value <> "" Then ActiveCell.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
 
        ActiveCell.Value = Num_Fact
      ActiveCell.Offset(0, 1).Value = Date_Fact
      ActiveCell.Offset(0, 2).Value = Nom_client
      ActiveCell.Offset(0, 3).Value = Indice_Devis
      ActiveCell.Offset(0, 4).Value = Montant_DevisHT
      ActiveCell.Offset(0, 5).Value = Montant_DevisTTC
 
Call Hyperlink
 
ActiveWorkbook.Saved = False
 
ActiveWorkbook.Close
 
 
End Sub[ATTACH]85408[/ATTACH]