Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Je souhaite localiser l'adresse de liens hypertextes.

Je souhaite localiser l'adresse de liens hypertextes.

21 réponses
Avatar
Emile63
Bonjour a tous,

Par le bout de code ci dessous, je rassemble dans un (nouvel) onglet,
toutes les adresse existantes sur une (longue) feuille Excel. Le
probleme c'est que je souhaite aussi localiser son adresse (absolue)
et a partir d'"ICI", j'avoue que je peine un peu. :-((
-Est-ce que quelque veut bien me mettre sur la voie, :-)

----------------------------------------------------------------------------------
Dim Z As Range
Dim N, I As IntegerSelection.CurrentRegion.Select
Set Z = Selection
N = Z.Hyperlinks.Count
Set FeuilFormulas = ActiveWorkbook.Worksheets.Add
ActiveSheet.Name = "FeuilFormulas "
FeuilFormulas .Range("A1") = "Cellule"
FeuilFormulas .Range("B1") = "Lien"
FeuilFormulas .Range("C1") = "Contenu"
FeuilFormulas .Range("D1") = "Adresse"
Ligne= 2
If N > 0 Then
For I = N To 1 Step -1
If InStr(Z.Hyperlinks(I).Address, "@") <> 0 Then GoTo Suivre

With FeuilFormulas
Cells(Ligne, 2) = Z.Hyperlinks(I).ScreenTip
Cells(Ligne, 1) = " " & Z.Hyperlinks(I).Name
Cells(Ligne, 3) = Z.Hyperlinks(I).Address()
' Cells(Ligne, 4) = Z.Range.Cells.Address() <-- ICI
Ligne= Ligne+ 1
End With
Suivre:
Next I
End If
FeuilFormulas .Columns("A:D").AutoFit
ActiveSheet.Range("A1").Select
Application.ScreenUpdating = True
End Sub

----------------------------------------------------------------------------------
Je vous remercie d'avance pour votre aide,
Cordialement,
Emile
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2 3
Avatar
DanielCo
Bonjour.
Je ne suis pas sûr de bien comprendre... Peux-tu donner un exemple ?
Cordialement.
Daniel


Bonjour a tous,

Par le bout de code ci dessous, je rassemble dans un (nouvel) onglet,
toutes les adresse existantes sur une (longue) feuille Excel. Le
probleme c'est que je souhaite aussi localiser son adresse (absolue)
et a partir d'"ICI", j'avoue que je peine un peu. :-((
-Est-ce que quelque veut bien me mettre sur la voie, :-)

----------------------------------------------------------------------------------
Dim Z As Range
Dim N, I As IntegerSelection.CurrentRegion.Select
Set Z = Selection
N = Z.Hyperlinks.Count
Set FeuilFormulas = ActiveWorkbook.Worksheets.Add
ActiveSheet.Name = "FeuilFormulas "
FeuilFormulas .Range("A1") = "Cellule"
FeuilFormulas .Range("B1") = "Lien"
FeuilFormulas .Range("C1") = "Contenu"
FeuilFormulas .Range("D1") = "Adresse"
Ligne= 2
If N > 0 Then
For I = N To 1 Step -1
If InStr(Z.Hyperlinks(I).Address, "@") <> 0 Then GoTo Suivre

With FeuilFormulas
Cells(Ligne, 2) = Z.Hyperlinks(I).ScreenTip
Cells(Ligne, 1) = " " & Z.Hyperlinks(I).Name
Cells(Ligne, 3) = Z.Hyperlinks(I).Address()
' Cells(Ligne, 4) = Z.Range.Cells.Address() <-- ICI
Ligne= Ligne+ 1
End With
Suivre:
Next I
End If
FeuilFormulas .Columns("A:D").AutoFit
ActiveSheet.Range("A1").Select
Application.ScreenUpdating = True
End Sub

----------------------------------------------------------------------------------
Je vous remercie d'avance pour votre aide,
Cordialement,
Emile
Avatar
Emile63
On 15 sep, 17:12, Emile63 wrote:
Bonjour a tous,

Par le bout de code ci dessous, je rassemble dans un (nouvel) onglet,
toutes les adresse existantes sur une (longue) feuille Excel. Le
probleme c'est que je souhaite aussi localiser son adresse (absolue)
et a partir d'"ICI", j'avoue que je peine un peu.  :-((
-Est-ce que quelque veut bien me mettre sur la voie,   :-)

------------------------------------------------------------------------- --­-------
Dim Z As Range
Dim N, I As IntegerSelection.CurrentRegion.Select
Set Z = Selection
N = Z.Hyperlinks.Count
Set FeuilFormulas = ActiveWorkbook.Worksheets.Add
ActiveSheet.Name = "FeuilFormulas "
FeuilFormulas .Range("A1") = "Cellule"
FeuilFormulas .Range("B1") = "Lien"
FeuilFormulas .Range("C1") = "Contenu"
FeuilFormulas .Range("D1") = "Adresse"
Ligne= 2
If N > 0 Then
    For I = N To 1 Step -1
        If InStr(Z.Hyperlinks(I).Address, "@") <> 0 Then GoTo Sui vre

        With FeuilFormulas
            Cells(Ligne, 2) = Z.Hyperlinks(I).ScreenTip
            Cells(Ligne, 1) = " " & Z.Hyperlinks(I).Name
            Cells(Ligne, 3) = Z.Hyperlinks(I).Address()
       '    Cells(Ligne, 4) = Z.Range.Cells.Address()   < --  ICI
            Ligne= Ligne+ 1
        End With
Suivre:
    Next I
End If
FeuilFormulas .Columns("A:D").AutoFit
ActiveSheet.Range("A1").Select
Application.ScreenUpdating = True
End Sub

------------------------------------------------------------------------- --­-------
Je vous remercie d'avance pour votre aide,
Cordialement,
Emile



Bonjour Daniel,
Merci pour ton intérêt.

Par exemple, actuellement j'obtiendrais ceci:
-------------------------------------------------------------
Val.Cellule | Info cellule | lien hypertexte | adresse
Micro$oft Aller sur le site www.microsoft.fr
-------------------------------------------------------------

Et je cherche a obtenir cela:
-------------------------------------------------------------
Val.Cellule | Info cellule | lien hypertexte | adresse sur
la feuille
Micro$oft Aller sur le site www.microsoft.fr =Mesadresses!$E
$6
-------------------------------------------------------------
Je cherche a faire figurer sur la table générée l'adresse (de la
cellule) ou se trouve le lien en question...
C'est plus facile a trouver, étant donné que j'ai plusieures centaines
de liens..
Merci pour ton aide,
Cordialement,
Emile
Avatar
Emile63
Bonjour a tous,

Quelle galère... Je bricole autour de "SubAddress" mais je ne trouve
pas.
Un petit coup de main me serrait bien utile :-))
-Est-que mon exemple n'est pas clair?
Merci pour vos suggestions,
Cordialement,
Emile
Avatar
Fredo P.
C'est , je crois, ce que tu souhaites obtenir, ou, quelque chose de
similaire.
http://cjoint.com/?jqtxRWR8br

"Emile63" a écrit dans le message de news:

Bonjour a tous,

Quelle galère... Je bricole autour de "SubAddress" mais je ne trouve
pas.
Un petit coup de main me serrait bien utile :-))
-Est-que mon exemple n'est pas clair?
Merci pour vos suggestions,
Cordialement,
Emile
Avatar
Emile63
Bonjour Fredo,
Merci pour ton aide.
J'ai mentionné le nom de "Micro$oft" sur mon exemple parcequ'il est
bien connu de tous.
Mais mon original comprend des centaines de fournisseurs et sous-
traitants.
Je n'ai pas besoin de suprimer les doublons.
Tout mon intérêt se porte sur ta ligne:
Cells(Lg, 4) = Feuil1.Range("E2:Q200").Find(h.Name).Address
Qui est, ce qui ne fonctionne pas sur ma procédure.
Rapporter l'adresse cellule du lien (Ex: FEUIL1!$C$17).
Sur ma proc.:
Cells(Ligne, 4) = Z.Range.Cells.Address()

Est-ce que tu peux me dire comment le résoudre ? :-)

Cordialement,
Emile
Avatar
Fredo P.
Bonjour Emile63
Essaye cette correction

Public Sub Emile()
Dim Z As Range
Dim N, I As Integer
Application.ScreenUpdating = False
'Selection.CurrentRegion.Select
Set Z = Selection
N = Z.Hyperlinks.Count
Set FeuilFormulas = ActiveWorkbook.Worksheets.Add
ActiveSheet.Name = "FeuilFormulas "
[A1] = "Cellule"
[B1] = "Lien"
[C1] = "Contenu"
[D1] = "Adresse"
Ligne = 2
If N > 0 Then
For I = N To 1 Step -1
If InStr(Z.Hyperlinks(I).Address, "@") = 0 Then
Cells(Ligne, 2) = Z.Hyperlinks(I).ScreenTip
Cells(Ligne, 1) = " " & Z.Hyperlinks(I).Name
Cells(Ligne, 3) = Z.Hyperlinks(I).Address()
Cells(Ligne, 4) = Z(I).Address '< --ICI
Ligne = Ligne + 1
End If
Next I
End If
Columns("A:D").AutoFit
ActiveSheet.Range("A1").Select
Application.ScreenUpdating = True
End Sub
"Emile63" a écrit dans le message de news:

Bonjour Fredo,
Merci pour ton aide.
J'ai mentionné le nom de "Micro$oft" sur mon exemple parcequ'il est
bien connu de tous.
Mais mon original comprend des centaines de fournisseurs et sous-
traitants.
Je n'ai pas besoin de suprimer les doublons.
Tout mon intérêt se porte sur ta ligne:
Cells(Lg, 4) = Feuil1.Range("E2:Q200").Find(h.Name).Address
Qui est, ce qui ne fonctionne pas sur ma procédure.
Rapporter l'adresse cellule du lien (Ex: FEUIL1!$C$17).
Sur ma proc.:
Cells(Ligne, 4) = Z.Range.Cells.Address()

Est-ce que tu peux me dire comment le résoudre ? :-)

Cordialement,
Emile
Avatar
Fredo P.
Ah!, j'oubliais, j'ai sélectionné la plage des hyperlink avant de démarrer
la proc. Emile

"Emile63" a écrit dans le message de news:

Bonjour Fredo,
Merci pour ton aide.
J'ai mentionné le nom de "Micro$oft" sur mon exemple parcequ'il est
bien connu de tous.
Mais mon original comprend des centaines de fournisseurs et sous-
traitants.
Je n'ai pas besoin de suprimer les doublons.
Tout mon intérêt se porte sur ta ligne:
Cells(Lg, 4) = Feuil1.Range("E2:Q200").Find(h.Name).Address
Qui est, ce qui ne fonctionne pas sur ma procédure.
Rapporter l'adresse cellule du lien (Ex: FEUIL1!$C$17).
Sur ma proc.:
Cells(Ligne, 4) = Z.Range.Cells.Address()

Est-ce que tu peux me dire comment le résoudre ? :-)

Cordialement,
Emile
Avatar
Emile63
Bonjour Fredo,

Merci pour ta persévérence. ;-)
Ya progrès.. Parceque des adresses s'affichent (finalement)
Le problème c'est qu'elle ne correspondent pas à l'endroit ou se
trouve le lien... :-((
La pluspart des adresses pointent sur des cellules vides ou qui
contiennent du texte...
et quand elles pointe sur un lien, c'est du au hasard mais ce lien ne
correspond pas a l'adresse...
:-((
Je te remercie d'avance pour ton aide,
Cordialement
Emile
Avatar
isabelle
bonjour Emile,

tu pourrais faire la boucle sur la collection Hyperlinks

Dim hp As Hyperlink
For Each hp In ActiveSheet.Hyperlinks
adresse = hp.Parent.Address
ligne = hp.Parent.Row
Next

isabelle

Le 2010-09-17 05:34, Emile63 a écrit :
Bonjour Fredo,

Merci pour ta persévérence. ;-)
Ya progrès.. Parceque des adresses s'affichent (finalement)
Le problème c'est qu'elle ne correspondent pas à l'endroit ou se
trouve le lien... :-((
La pluspart des adresses pointent sur des cellules vides ou qui
contiennent du texte...
et quand elles pointe sur un lien, c'est du au hasard mais ce lien ne
correspond pas a l'adresse...
:-((
Je te remercie d'avance pour ton aide,
Cordialement
Emile
Avatar
Fredo P.
Voila Emile, tu peux faire entièrement confiance à Isabelle
C'est comme Obélix, petite, elle a du tombé dans l'Excellence !
Un grand merci & une grosse bise à Isabelle


Public Sub Emile()
Dim Z As Range
Dim N, I As Integer
Application.ScreenUpdating = False
'Selection.CurrentRegion.Select '<<<<<<<<<<<à adapter
Set Z = [F10:K100] ' <<<<<<<<<<<à adapter
N = Z.Hyperlinks.Count
Set FeuilFormulas = ActiveWorkbook.Worksheets.Add
ActiveSheet.Name = "FeuilFormulas "
[A1] = "Cellule"
[B1] = "Lien"
[C1] = "Contenu"
[D1] = "Adresse"
Ligne = 2
If N > 0 Then
For I = N To 1 Step -1
If InStr(Z.Hyperlinks(I).Address, "@") = 0 Then
Cells(Ligne, 2) = Z.Hyperlinks(I).ScreenTip
Cells(Ligne, 1) = " " & Z.Hyperlinks(I).Name
Cells(Ligne, 3) = Z.Hyperlinks(I).Address()
Cells(Ligne, 4) = Z.Hyperlinks(I).Parent.Address '< --ICI
Ligne = Ligne + 1
End If
Next I
End If
End Sub
Columns("A:D").AutoFit
ActiveSheet.Range("A1").Select
Application.ScreenUpdating = True
End Sub


Ces Parents, on ne sait jamais ou les caser. o))
1 2 3