Creer lien hypertext suivant la donnée de la cellule

Bonjour à tous,

Je suis novice en VBA....

J'ai crée un tableau sous Excel de plusieurs colonne

Dans ma 1ère colonne j'ai listé des numéros de document avec 2 types de typologie : "Axxxxx" et "xxxxx"

Je souhaite utiliser une macro qui créer un lien hypertext sur chaque numéro de la liste.

Les numéros commençant par "A" devant pointer vers un fichier du même nom dans un dossier défini.

Les numéros ne commençant pas par "A" devant pointer vers un fichier du même nom dans un autre dossier défini.

Je pensais utiliser la fonction de filtre automatique mais VBA créer le lien sur les cellules cachées par le filtre.

Quelqu'un aurait-il une solution à me proposer?

C'est à dire que le lien se crée uniquement sur les cellules filtrées (ou un autre moyen d'arriver à mes fins)

Il me sera d'un grande utilité dans mon travail quotidien

Ci dessous mon code.

Sub filtre_numero_de_plan()

'

' filtrer les cellules commencant par "A"

ActiveSheet.ListObjects("Tableau2478").Range.AutoFilter Field:=1, Criteria1 _

:="=A*", Operator:=xlAnd

'creation du lien pour chaque cellule du tableau vers le dossier "assem"

For Each Cel In Range("A4:A" & [A65000].End(xlUp).Row)

ActiveSheet.Hyperlinks.Add Anchor:=Cel.Offset(0, 0), Address:= _

"G:\Archivage\Petro Assem\" & Cel.Value & ".tif", TextToDisplay:=""

'suppression du filtre

ActiveSheet.ListObjects("A:A").Range.AutoFilter Field:=1

' filtrer les cellules ne commencant pas par "A"

ActiveSheet.ListObjects("Tableau2478").Range.AutoFilter Field:=1, Criteria1 _

:="<>A*", Operator:=xlAnd

'creation du lien pour chaque cellule du tableau vers le dossier "Moules"

For Each Cel In Range("A4:A" & [A65000].End(xlUp).Row)

ActiveSheet.Hyperlinks.Add Anchor:=Cel.Offset(0, 0), Address:= _

"G:\Archivage\Petro Moules\" & Cel.Value & ".tif", TextToDisplay:=""

'suppression du filtre

ActiveSheet.ListObjects("Tableau24783").Range.AutoFilter Field:=1

Next Cel

End Sub

MERCI PAR AVANCE POUR VOTRE AIDE

34suivi-plans.xlsm (20.77 Ko)

Bonjour,

Beaucoup de programme qui ne sert pas à grand chose si tu veux mon avis, pourquoi filtrer quand tu peux directement appliquer tel ou tel type de lien en fonction de la valeur de la cellule, le tout via un If?

Idem pour ta façon de parcourir toutes les lignes, tu n'as pas besoin de parcourir toutes les lignes de la ligne 4 à 65000, tu peux facilement trouver la dernière cellule remplie dans la colonne A en partant de la dernière ligne du fichier, plus précis, plus rapide

Je te montre le résultat et te laisse me faire un retour

Petite note : pour le If j'utilise un comparateur de texte hyper utile qui se nomme Like, il permet de tester dans ce cas que le texte commence par A (Like "A*"), je te laisse voir

Salut Ausecour (beau speudo au passage )

Meri pour ta réponse très rapide.

Et bien écoute, j'ai exploré rapidement ton fichier (un peu compliqué pour mon niveau actuel) puis je me suis concentré sur les fonctions if et like et ça fonctionne impeccable!!!

Cela faisait quelques jours que je me prenais la tète sur ce code et tu m'as dépatouillé en quelques minutes.

(Ceci dit, lors de mes 1ers essais j'utilisais la commande if mais cela ne fonctionnait pas... )

Voici le code que je viens de remodeler avec tes conseils, en effet beaucoup plus simple....

For Each Cel In Range("A4:A" & [A65000].End(xlUp).Row)

If Cel Like "A*" Then

ActiveSheet.Hyperlinks.Add Anchor:=Cel.Offset(0, 0), Address:= _

"G:\Archivage\Petro Assem\" & Cel.Value & ".tif", TextToDisplay:=Cel.Value

Else

ActiveSheet.Hyperlinks.Add Anchor:=Cel.Offset(0, 0), Address:= _

"G:\Archivage\Petro Moules\" & Cel.Value & ".tif", TextToDisplay:=Cel.Value

End If

Next

Merci encore de ton aide!

Rebonjour,

Pas de soucis

En revanche j'ai quelques remarque sur ton programme parce qu'il n'est pas parfait (en tout cas je vois des soucis :p)

Range("A4:A" & [A65000].End(xlUp).Row)

Le soucis c'est que les fichiers Excel ne finissent pas forcément à la ligne 65000, le mieux c'est d'utiliser la variable rows.count pour avoir le numéro de la dernière ligne du fichier, adapté à ton cas ça donnerait :

Range("A4",range("A" & rows.count).End(xlUp)) 'tu peux mettre deux références de cellules pour ton Range, ça sélectionne tout ce qui est entre

Ensuite la méthode ActiveSheet.Hyperlinks me gêne un peu... Parce que si par exemple tu voulais mettre un lien dans une cellule d'une autre feuille, eh bien ça ne fonctionnerait pas, je préfère directement utiliser cel.hyperlinks qui est plus sûre, comme ça tu sais que c'est bien la bonne cellule qui a ensuite son lien hypertexte.

Sinon tu as bien compris, bravo :p

EDIT: attentiont c'était le fichier d'un autre sujet qui s'est retrouvé en pièce jointe, je ne sais pas trop pourquoi, j'ai remis le bon fichier au cas où

Merci pour ces précisions.

C'est du perfectionnisme pour moi mais effet je comprend bien leur utilité et autant faire les choses bien jusqu'au bout.

Je les ai appliqué, ça fonctionne nickel.

Merci encore.

Je reviendrais certainement poser 2-3 questions sur ce forum car j'en ai pas finit avec ce tableau

Pas de soucis, mais sur un autre sujet alors

Bonjour,

Bon je rencontre un nouveau souci...

La macro fonctionnait très bien hier.

J'ai donc inséré une nouvelle feuille avec des nouveaux numéros pour (enfin) profiter de cette belle fonction et là...fenêtre de débogage avec l'erreur suivante que je n'arrive pas comprendre....

erreur d'exécution '5'

Argument ou appel de procédure incorrect

Sur le fichier joint, la feuille BASE(2) est une copie de la feuille BASE, j'ai uniquement modifié les numéros de plan

et la macro fonctionne parfaitement sur BASE et bug sur BASE(2)

45suivi-plans.xlsm (26.49 Ko)

Quelqu'un saurait-il d'où l'erreur peux venir?

Bonjour,

Le soucis n'était pas évident mais j'ai trouvé, la seule différence avec l'ancien code c'est TexttoDisplay où tu veux afficher la valeur de la cellule (chose qui ne sert pas d'ailleurs comme tu spécifie le texte à afficher uniquement pour changer de ce qu'il y a dans la cellule).

Le truc c'est que dans la première feuille tu as du texte, alors que dans l'autre tu as des nombres, et tu essayes d'affecter à un texte (texttodisplay attend du texte) avec une valeur numérique, si tu rajoutes une fonction de conversion en texte, plus de soucis, donc ton problème sera réglé par la fonction Cstr()

ça te donnera le code suivant :

Sub Creation_lien_archivage()

    Columns("A:A").Select
    Application.WindowState = xlMaximized
    selection.Replace What:="/", Replacement:="-", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("A1").Select

    For Each Cel In Range("A4", Range("A" & Rows.Count).End(xlUp))
        If Cel Like "A*" Then
         Cel.Hyperlinks.Add Anchor:=Cel.Offset(0, 0), Address:= _
            "G:\Archivage\Petro Assem\" & Cel.Value & ".tif", TextToDisplay:=Cel.Value
        Else
         Cel.Hyperlinks.Add Anchor:=Cel.Offset(0, 0), Address:= _
            "G:\Archivage\Petro Moules\" & Cel.Value & ".tif", TextToDisplay:=CStr(Cel.Value)
        End If
    Next

End Sub

En effet, c'est logique quand on explique bien

Je pensais pourtant avoir bien spécifié "texte" dans les formats de cellule mais bon...ça fonctionne c'est le principal!

Aussi, l'option de ne pas spécifier le texte à afficher fonctionne uniquement si la valeur est un nombre.

Si ma valeur est un texte commençant par "A" et que je ne spécifie pas de valeur à afficher, Excel va afficher le chemin d’accès.

Merci encore de ton aide Ausecour!

Ah oui en effet, c'est possible ça!

Je suppose que c'est encore la logique texte/nombre qui fait que ça remplace du texte mais pas un nombre...

Le format ne fait pas toujours tout tu sais, le nombre de fois qu'Excel me fait des choses étranges au niveau du format...

Rechercher des sujets similaires à "creer lien hypertext suivant donnee"