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 |
Partager