Extraire des liens hypertextes

[Resplaf]

Salut,

J'ai une liste de terme dans une colonne. Chacun renferme ou contient (je ne sais comment dire) un lien hypertexte.

Existe-t-il une fonction permettant d'extraire (pour toute la colonne) ces liens pour les coller dans la cellule d'à coté par exemple ?

perso je n'ai rien trouvé...

Rendez-vous compte : cette fonction qui me semble basique ne semble même pas exister sur les dreamweaver et consors...

Merci d'avance
A+
resplaf

 

[michel]

bonsoir Resplaf

la macro ci dessous extrait les liens hypertextes de la colonne A et les affiche dans la colonne B

Sub ExtractionLiensHypertextes()
Dim Cell As Range
On Error Resume Next
For Each Cell In Range("A1:A" & Range("A65536").End(xlUp).Row)
Cell.Offset(0, 1) = Cell.Hyperlinks(1).Address
Next Cell
End Sub


bonne soiree
michel

 

[Resplaf]

Merci Michel
Trop fort !
Au plaisir

Resplaf

 

[LTBG]

Merci pour vos reponses, c'est bien ce que je cherchais

Mais euuhh ... comment dire , comment fait on cette macro ?

Par exemple données dans la colonne A, je voudrais l'email correspondant dans la colonne B ?

Merci pour votre aide

 

[la lozere]

Re : Extraire des liens hypertextes

Bonjour,
Je remonte un vieux sujet car il correspond à 80% à ce que je veux. Mais il y a les 20% restant
Je sais que sous excel, je sais qu'il est possible de créer de nouvelle fonctions. Ainsi, je voudrais la même chose mais via une nouvelle fonction du type:
Exemple:
-En A3 j'aurais un lien hypertexte
-Et en B3, j'aurais une fonction du type "=fonction(A3)".

Ainsi, en B3, cela me renverrait sous forme de texte le lien hypertexte de la cellule A3.
Quelqu'un saurait-il faire, car la je suis collé..

Merci d'avance.

 

[la lozere]

Re : Extraire des liens hypertextes

Re

En faisant une recherche sur le forum, j'ai bien trouvé ce bout de code, il marche mais les cellule ne ce mettent pas à jour automatiquement. Il faut re-rentrer dans la cellule et re-valider

 Function AdresseLien(Cellule As Range) As String
    AdresseLien = ""
    If Cellule.Hyperlinks.Count > 0 Then
        AdresseLien = Cellule.Hyperlinks(1).Address
    End If
End Function

De plus, cela n'extrait le lien qu'en relatif et non en absolue.

Merci

 

[tototiti2008]

Re : Extraire des liens hypertextes

Bonjour la lozere,

Oui, modifier l'adresse d'un lien ne provoque pas de recalcul

modifie la fonction comme suit :

Function AdresseLien(Cellule As Range) As String
Application.Volatile
    AdresseLien = ""
    If Cellule.Hyperlinks.Count > 0 Then
        AdresseLien = Cellule.Hyperlinks(1).Address
    End If
End Function

Il faudra tout de même appuyer sur la touche F9 pour mettre à jour les résultats de ta fonction

Edit : Pour les adresses relatives ou absolues, tout dépend de l'adresse enregistrée dans le lien, je crois

 

[la lozere]

Re : Extraire des liens hypertextes

Oups, tu as répondu en même temps que je modifiais mon post.
Merci ça marche maintenant. Et comme c'est sur des onglets différents, cela recalcule automatiquement. Par contre c'est super long à ouvrir cet onglet, mais cela vient surement du fait que j'ai 550 lignes avec cette nouvelle fonction.

Et comme je le disais, "cela n'extrait le lien qu'en relatif et non en absolue"

Merci.

 

[scope]

Re : Re: Extraire des liens hypertextes

Hello Michel,

J'ai essayé ta macro mais ca n'a pas fonctionné, tu pourrais m'envoyer un fichier excel contenant la macro avec un exemple ? Le lien hypertext que j'aimerais télécharger pointe sur une image compressé (zip). A télécharger à la rigueur sur mon disque.

Merci de ton aide.

bonsoir Resplaf

la macro ci dessous extrait les liens hypertextes de la colonne A et les affiche dans la colonne B

Sub ExtractionLiensHypertextes()
Dim Cell As Range
On Error Resume Next
For Each Cell In Range("A1:A" & Range("A65536").End(xlUp).Row)
Cell.Offset(0, 1) = Cell.Hyperlinks(1).Address
Next Cell
End Sub


bonne soiree
michel

 

[Staple1600]

Re : Extraire des liens hypertextes

Bonsoir à tous

scope [Bienvenue sur le forum]
Il serait plus judicieux que tu crées ta propre discussion.
NB: la macro fonctionne très bien
Mais elle ne sert en aucun cas à télécharger quoique ce soit
Il s'agit d'extraire les liens (URL) dans la colonne adjacente.

Sinon puisque que tu causes téléchargement, à toutes fins utiles, je te rappelle ce point de la charte

8 - Les demandes de développements relatives à des extractions de données sur des sites interdisant ces pratiques dans leurs conditions générales sont interdites.

 

[scope]

Re : Extraire des liens hypertextes

ok mais si elle marchait j'aurais pas poser la question. Donc restons sur l'exemple et essayons de voir si Michel peut me communiquer un fichier excel pour que je puisse voir ou se situe mon erreur. merci.

 

[Staple1600]

Re : Extraire des liens hypertextes

Re

scope
Il y a une différence entre une macro qui fonctionne et une personne qui n'arrive pas à la faire fonctionner...
Je te certifie qu'elle fonctionne.
Mais il se peut que tu n'arrives pas à la faire fonctionne, ce qui n'est plus la même histoire.

La preuve en image ci-dessous du bon fonctionnement de la macro de michel
(quand à michel (que je connais) il ne fréquente plus ce site depuis belle lurette)

Et encore une fois, tu devrais créer ton propre fil et ne pas réactiver un fil vieux de 10 ans.

 

[scope]

Re : Extraire des liens hypertextes

Je crois que je perds mon temps avec toi et je vais faire comme michel qui ne dois pas supporter tes sautes humeurs ! byby

 

[Staple1600]

Re : Extraire des liens hypertextes

Re

scope
Quand on ne veut pas entendre...
Je viens de tester le code de Michel présent dans ce fil( d’où ma copie d'écran, voir précédent message)
Et je persiste à dire que la macro fonctionne telle qu'elle...

C'est toi qui perds ton temps à ne pas vouloir entendre.
(Fais le même test, que moi, et tu verras qu'elle fonctionne)

 

[Staple1600]

Re : Extraire des liens hypertextes

Re

scope
Pour mettre un point final et tu puisses enfin te rendre compte qu'elle fonctionne cette macro.
Lances ce test dans un classeur vierge.
Lances la macro TestPourScope
Convaincu désormais ?

Sub TestPourScope()
ActiveSheet.Hyperlinks.Add Anchor:=Cells(1, 1), Address:= _
        "http://www.excel-downloads.com/forum/19138-extraire-des-liens-hypertextes.html" _
        , TextToDisplay:= _
        "http://www.excel-downloads.com/forum/19138-extraire-des-liens-hypertextes.html"
 Range("A1:A5").Select
 Selection.FillDown
Call LaMacroAMichelQuiNeFonctionnePasMaisQUIFONCTIONNE
Columns("A:B").Columns.AutoFit
End Sub

Sub LaMacroAMichelQuiNeFonctionnePasMaisQUIFONCTIONNE()
'Sub ExtractionLiensHypertextes()
Dim Cell As Range
On Error Resume Next
For Each Cell In Range("A1:A" & Range("A65536").End(xlUp).Row)
Cell.Offset(0, 1) = Cell.Hyperlinks(1).Address
Next Cell
End Sub