[XL-2007] VBA - Hypertexte à partir de la valeur active [Résolu]

[Myst3ryssss]

Bonjour à tous,

Question rapide, mais pour laquelle je n'arrive à rien!
J'aimerais "fabriquer" un lien hypertexte à partir d'un NOM enregistré ainsi que de la valeur de la cellule active.

Exemple (c'est toujours plus simple ):

A1 = "CF001"
A2 = "CF939"
A3 = "GHD45"
etc...
Le nom "chemin_fichier" contient: C:blabla/blabla/blabla
Le nom "nom_fichier" contient la sélection: (A1:A3)

Ainsi, en VBA je veux que pour chaque cellule de la sélection (A1:A3), ma macro crée un lien hypertexte de cette forme:
C:blabla/blabla/blabla/CF001 (Pour la cellule A1)
C:blabla/blabla/blabla/CF939 (Pour la cellule A2)
C:blabla/blabla/blabla/GHD45 (Pour la cellule A3)

J'ai essayé le code ci-dessous, mais je bloque à l'argument Adresse

Code :

1
2
3
4
5
6
7
8
9
10
11
 
 
    With Worksheets("sheets1")
    Dim adresse As String
 
        Range("nom_fichier").Select
            For Each cell In Selection
                adresse = ?????
                ActiveSheet.Hyperlinks.Add Anchor:=cell, Address:=adresse
            Next
    End With

Merci d'avance de votre aide!
Maxime

P.s. Petite question en parallèle sur les liens hypertextes. Est-ce que pour un lien Excel part de l’emplacement du fichier Excel actuel pour allez ouvrir un autre fichier si on n'indique pas de C:blabla/dossier/ficher? En d'autres mots, serait-il possible d'aller ouvrir un fichier en marquant simplement /dossier/fichier.jpg?

[ZebreLoup]

Code :

adresse = Range(chemin_fichier) & "\" & cell.Value

Et pour ce qui est du chemin relatif, j'ai le code suivant à ajouter dans un module :

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
Option Explicit
 
Public Function getAbsoluteFromRelativePath(strRelPath As String, actualPath As String) As String
 
While Left(strRelPath, 3) = "..\"
    strRelPath = Right(strRelPath, Len(strRelPath) - 3)
    actualPath = getHigherLevel(actualPath)
Wend
 
If Left(strRelPath, 2) = ".\" Then strRelPath = Right(strRelPath, Len(strRelPath) - 2)
 
getAbsoluteFromRelativePath = actualPath & "\" & strRelPath
 
End Function
 
Private Function getHigherLevel(strPath As String) As String
 
Dim tabPath() As String
tabPath = Split(strPath, "\")
Dim n As Integer
n = UBound(tabPath)
ReDim Preserve tabPath(n - 1)
getHigherLevel = Join(tabPath, "\")
 
End Function

Que l'on peut utiliser en faisant par exemple :

Code :

1
2
3
4
Dim completePath As String
completePath = getAbsoluteFromRelativePath("..\..\Test", ThisWorkbook.Path)
'ou
completePath = getAbsoluteFromRelativePath(".\Test", ThisWorkbook.Path)

[Myst3ryssss]

Que dire de plus?

Merci! absolument, merci!
C'est à 100% ce que je recherchais.

[ZebreLoup]

Pas de problème. N'oublie pas de marquer ton sujet comme résolu et d'utiliser les "pouces" pour dire si les réponses te conviennent ou pas.
Bonne journée