Je souhaite localiser l'adresse de liens hypertextes.

Le
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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses Page 1 / 3
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
DanielCo
Le #22572861
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
Emile63
Le #22573061
On 15 sep, 17:12, 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 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
Emile63
Le #22576281
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
Fredo P.
Le #22576731
C'est , je crois, ce que tu souhaites obtenir, ou, quelque chose de
similaire.
http://cjoint.com/?jqtxRWR8br

"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
Emile63
Le #22578071
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
Fredo P.
Le #22578191
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"
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
Fredo P.
Le #22578181
Ah!, j'oubliais, j'ai sélectionné la plage des hyperlink avant de démarrer
la proc. Emile

"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
Emile63
Le #22578311
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
isabelle
Le #22578351
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
Fredo P.
Le #22578551
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))
Publicité
Poster une réponse
Anonyme