(VBA) Extraction Lien Hypertexte pas complet

Bonjour à tous,

J'ai trouvé sur ce Forum un bout de code VBA pour extraire les Lien Hypertexte d'une cellule.

Le code fonctionne, le lien Hypertexte est collé dans la cellule à côté mais mon problème est qu'il n'est pas complet.

Quand je vais chercher par moi même dans la cellule pour modifier le lien Hypertexte, il m'affiche ce lien:

http://dlvxplm1/WebAccess/home.html#URL=C1650832

Mais avec le code VBA pour extraire il ne m'affiche dans la cellule que cette partie:

http://dlvxplm1/WebAccess/home.html

Or j'ai vraiment besoin d'avoir l'information complète...

Auriez vous une idée?

Sub email()

' E_mail Macro

On Error Resume Next
For Each Cell In Range("D6:D" & Range("D19").End(xlUp).Row)
Cell.Offset(0, 1) = Cell.Hyperlinks(1).Address
Next Cell

End Sub

bonjour,

essaie avec .name au lieu de .address

Bonjour,

D'abord un grand merci pour ta réponse

J'ai essayé, mais du coup il me donne le nom de la cellule où il y a le lien Hypertexte et plus du tout de lien.

bonjour,

pourtant ceci me donne bien l'adresse complète du lien.

MsgBox Range("A1").Hyperlinks(1).Name

Alors ça c'est fort,

ça ne marche pas chez moi :o

La case D6 est la case avec le ETE 2021 (mais le lien Hypertexte derrière est le http://dlvxplm1/WebAccess/home.html#URL=C1650832)

Rebonjour,

Si j'introduis d'abord le lien et que je modifie le contenu de la cellule cela fonctionne, par contre si j'ajoute un lien pour une cellule qui a déjà une contenu cela ne fonctionne plus. Le nom du lien correspond au contenu initial de la cellule (ça parait logique, j'ai encore appris quelque chose !, merci)

donc une alternative. Le seul bémol c'est qu'il faut ajouter le # et que je ne suis pas sûr que ce soit toujours ce caractère qui est le séparateur.

Sub aargh()
    lien = Range("A1").Hyperlinks(1).Address
    On Error Resume Next
    parm = Range("A1").Hyperlinks(1).SubAddress
    On Error GoTo 0
    MsgBox lien & "#" & parm
End Sub

"Sub aargh()" J'ai bien rigolé ahhaha.
Sinon la bonne nouvelle c'est que le # est toujours le caractère qui sépare les deux chaines. et maintenant ça fonctionne bien, la Box me donne le lien complet ;D

[EDIT] J'ai trouvé comment compiler les deux.

Je post la réponse ici si ça peut aider des autres personnes.

On Error Resume Next
For Each Cell In Range("D6:D" & Range("D11").End(xlUp).Row)
Cell.Offset(0, 1) = Cell.Hyperlinks(1).Address & "#" & Cell.Hyperlinks(1).SubAddress
Next Cell