[XL-2010] création hypertext automatique

[macguinness]

bonjour
Je cherche a faire une création automatique de lien hypertext. J'ai un tableau avec une colonne A qui contient des le nom de matériels, et un colonne B qui contient le numéro du catalogue de pièces détachées. Je voudrais que dans la colonne C se crée automatiquement un lien hypertexte qui pointe vers le fichier pdf. Le nom du fichier pdf est de type 123456.pdf et ce numero est dans la colonne B (123456 sans le .pdf)

A vous lire

merci
Sébastien

[78chris]

bonjour

La fonction LIEN_HYPERTEXTE() ne conviendrait-elle pas ?

[Antoniom]

Hello,

Vois le fichier joint, ou sinon procède comme suit :

1)
Colonne A les noms comme suit :
A2 = A
A3 = B
A4 = C
A5 = D

Colonne B numéros
B2 = 123
B3 = 456
B4 = 789
B5 = 1011

2)
Ensuite dans un dossier tu mets quatre fichiers pdf nommés :

123.pdf, 456.pdf, 789.pdf, 1011.pdf.

3)
Place un CommandButton sur la feuille et colle-lui ce code

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Private Sub CommandButton1_Click()
 
    Dim n As Long
 
    For n = 2 To Range("B1000").End(xlUp).Row
        If Cells(n, 2).Value <> "" Then
            Cells(n, 3).Value = Cells(n, 2).Value & ".pdf"
            Cells(n, 3).Hyperlinks.Add Anchor:=Cells(n, 3), Address:=Cells(n, 3).Value, _
                TextToDisplay:=Cells(n, 3).Value
        Else
            Cells(n, 3).Value = ""
            Exit Sub
        End If
    Next n
 
End Sub

Espérant avoir été clair.

Bonne nuit.

[tompom3108]

Bonjour je préviens je ne suis pas expert, mais j'ai eu un problème similaire il y a peu. Je te donne le code avec la fonction find que j'ai utilisé à adapter si possible.

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
'---------------------------------------------------------------------------------------ajout du lien hypertexte
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 des 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("CC2011T.xlsx")
wb.Activate
Worksheets("Pilote").Activate
'-----------------------------------Début de la recherche de cellule à mettre en lien
 
Range("A4").Select
Set Macible = Columns("A:A").Find(What:=NumFact, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=True)
'-----------------------------------Mise en place du lien
ActiveSheet.Hyperlinks.Add Macible, filename
 
 
End Sub

Bon courage