[XL-2007] lien hypertexte ça bug [Résolu]

[tompom3108]

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 :

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 :

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]

[ZebreLoup]

filename étant un string, tu ne dois pas mettre de set lors de l'affectation

[tompom3108]

Merci
J'ai pris en compte le conseil... Cependant j'ai un autre problème avec la variable Macible il me dit qu'il ne reconnait pas columns()? y a t il un moyen de corriger ça? Je sens que je me rapproche du but... ou pas.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
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
 filename = Rep & NumFact & " " & Client & ".xls"
 
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
End With
 
End Sub

parce qu'en fait j'aimerai qu'il trouve le NumFact dans la colonne 1 de la feuille DP! pour créer le lien hypertexte . Je ne sais pas si c'est la bonne méthode ça m a semblé logique...

[ZebreLoup]

Essaie en enlevant les guillemets sur NumFact

[tompom3108]

Bonjour Zebrelou merci de m'aider,

j'ai essayé sans les guillemets sur NumFact dans

Code :

1
2
Macible = Columns(1).Find(What:=NumFact, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns,
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=True)

mais ça ne change rien, il me dit erreur de compilation, erreur de syntaxe sur cette ligne.
Je vais essayer de bidouiller un truc avec

Code :

ActiveCell.End(xlDown).Select

Je viens d'essayer un autre truc ça ne marche pas non plus ...

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
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
 
'Workbooks("Modèle devis vba").Activate
ThisWorkbook.Activate
With Worksheets("Devis")
Rep = Worksheets("Menu").Range("C9").Value
    NumFact = .Range("F19").Value
    Client = .Range("J13").Value
End With
 filename = Rep & NumFact & " " & Client & ".xls"
 
 Workbooks("Devisprovisoire").Activate
    Sheets("DP").Activate
Range("A1").Select
If Range("A2").Value <> "" Then ActiveCell.End(xlDown).Select
'Macible = Columns(1).Find(What:="NumFact", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=True)
Macible = ActiveCell.Value
Set objLink = ActiveSheet.Hyperlinks.Add(Macible, objLink.Address)
With objLink
objLink.Address = filename
 
End With 
End Sub

Il n'aime pas le

Code :

Workbooks("Devisprovisoire").Activate

entre autre...Il y a aussi un moment dans l'archivage excel me demande si je veux modifier les liaisons ou continuer cela joue t il un rôle dans la création de lien hypertexte?

[ZebreLoup]

Find te renvoie un objet Range. MaCible doit donc être déclaré comme range et cette fois il te faudra un set.

Voici un code qui devrait marcher. Il faut bien vérifier que ton chemin en C9 se termine bien par "\".

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub Hyperlink()
 
Dim Rep As String, NumFact As String, Client As String
Dim Macible As Range
Dim filename As String
 
Application.ScreenUpdating = False
'Initialisation variables
Rep = Worksheets("Menu").Range("C9").Value
With Worksheets("Devis")
    NumFact = .Range("F19").Value
    Client = .Range("J13").Value
End With
 filename = Rep & NumFact & " " & Client & ".xls"
 
set Macible = Columns("A:A").Find(What:=NumFact, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=True)
ActiveSheet.Hyperlinks.Add Macible, filename
 
 
End Sub

[tompom3108]

Re-merci Zebreloup pour ton soutien

Tout d'abord la cellule "C9" se termine bien par "\".

Ensuite J'ai essayé le code mais le débogage révèle une erreur '9' (indice n'appartient pas à la sélection.) à ce niveau

Code :

Rep = Worksheets("Menu").Range("C9").Value

Du coup j'ai changé un peu le code j'ai essayé avec ça :

Code :

1
2
3
4
5
6
7
ThisWorkbook.Activate
With Worksheets("Devis")
Rep = Worksheets("Menu").Range("C9").Value
    NumFact = .Range("F19").Value
    Client = .Range("J13").Value
End With
 filename = Rep & NumFact & " " & Client & ".xls" etc.

Là il j'ai une "incompatibilité de type" "erreur deexécution '13' :"
sur cette ligne

Code :

1
2
Set Macible = Columns("A:A").Find(What:=NumFact, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=True)

J'ai donc rechangé le code et ajouté:

Code :

1
2
3
4
5
6
Workbooks("Devisprovisoire").Activate
Worksheets("DP").Activate
 
Set Macible = Columns("A:A").Find(What:=NumFact, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=True)
ActiveSheet.Hyperlinks.Add Macible, filename

Et encore une fois il me dit erreur '9' (indice n'appartient pas à la sélection.)sur la ligne

Code :

Workbooks("Devisprovisoire").Activate

Je signale qu'à chaque fois pendant la macro j'ai un avertissement qui me dit :
"Ce classeur contient une ou plusieurs liaisons qui ne peuvent pas être mis à jour" et me demande de continuer ou de modifier les liaisons. je sais pas si c'est normal je clique sur continuer (peut être parce ce que j'enregistre des feuilles comprenant des macro dans un autre classeur.)

Cette macro c'est mon mirage quand je crois l'avoir atteint elle s'éloigne ou disparaît

[tompom3108]

ok ça y est, je poste le code corrigé pour ceux qui en auraient besoin et merci encore à toi zebreloup pour ton aide.

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
Sub Hyperlink()
 
Dim Rep As String, NumFact As String, Client As String
Dim Macible As Range
Dim filename As String
Dim objLink As Hyperlink
Dim wb As Workbook
 
Application.ScreenUpdating = False
'Initialisation variables
 
ThisWorkbook.Activate
With Worksheets("Devis")
Rep = Worksheets("Menu").Range("C9").Value
    NumFact = .Range("F19").Value
    Client = .Range("J13").Value
End With
 filename = Rep & NumFact & " " & Client & ".xls"
 
Set wb = Workbooks("Devisprovisoire.xlsx")
wb.Activate
Worksheets("DP").Activate
 
Set Macible = Columns("A:A").Find(What:=NumFact, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=True)
ActiveSheet.Hyperlinks.Add Macible, filename
 
 
End Sub

Là ça marche yeepee