OVH Cloud OVH Cloud

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

10 réponses

1 2 3
Avatar
Emile63
Bonjour Isabelle et Fredo,
Merci pour vos solutions. ;-)

Par rapport a Asterix et Obelix, je me verrais plutôt dans le rôle
d'un légionnaire.... :-))
Je prends les coups parceque quelqu'un devait bien être là, et les
prendres...
Mais avec la naïveté de celui qui ne sais pas ce qu'il l'attends.
Hi, hi, hi..
J'avoue que bien que j'ai compris le rôle de la "Boucle" que propose
Isabelle, je vois pas bien ou la placer pour la mettre en action dans
ton code...
Un dernier coup de main ?? :-)
Merci encore à vous deux,
Cordialement,
Emile
Avatar
Fredo P.
"Emile63" a écrit dans le message de news:

Bonjour Isabelle et Fredo,
Merci pour vos solutions. ;-)

Par rapport a Asterix et Obelix, je me verrais plutôt dans le rôle
d'un légionnaire.... :-))
Je prends les coups parceque quelqu'un devait bien être là, et les
prendres...
Mais avec la naïveté de celui qui ne sais pas ce qu'il l'attends.
Hi, hi, hi..
J'avoue que bien que j'ai compris le rôle de la "Boucle" que propose
Isabelle, je vois pas bien ou la placer pour la mettre en action dans
ton code...
§§ Isabelle te donnais un exemple à ne pas prendre forcément en totalité, la
clef de son message se trouve dans "Parent.Address" que j'ai placé dans ton
code remanié ci-aprés à la ligne qui, au départ, te posait problème et que
voila rectifiée.>>Cells(Ligne, 4) = Z.Hyperlinks(I).Parent.Address '< --ICI
§§

Emile


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
Columns("A:D").AutoFit
ActiveSheet.Range("A1").Select
Application.ScreenUpdating = True
End Sub
Avatar
michel ou sam
Bonjour,
j'ai testé les propriétés de l'objet Hyperlink en se basant sur ce que vous
proposez.
Les liens que j'ai créés pointent vers des cellules de la feuille 2

.TextToDisplay donne la même réponse que Name
.Address ne donne rien
Où est l'astuce ?

Voici ce que j'ai fait :

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] = "Nom"
[C1] = "info bulle"
[D1] = "cellule pointée"

Ligne = 2
If N > 0 Then
For I = N To 1 Step -1
If InStr(Z.Hyperlinks(I).Address, "@") = 0 Then
Cells(Ligne, 1) = Z.Hyperlinks(I).Parent.Address ' cellule où se
trouve le lien
Cells(Ligne, 2) = " " & Z.Hyperlinks(I).Name ' nom du lien
Cells(Ligne, 3) = Z.Hyperlinks(I).ScreenTip ' infobulle du lien
Cells(Ligne, 4) = Z.Hyperlinks(I).SubAddress ' adresse pointée
Cells(Ligne, 5) = Z.Hyperlinks(I).TextToDisplay 'même chose que
Name !
Cells(Ligne, 6) = Z.Hyperlinks(I).Address ' vide ! ?
Ligne = Ligne + 1
End If
Next I
End If
Columns("A:D").AutoFit
ActiveSheet.Range("A1").Select
Application.ScreenUpdating = True
End Sub

Michel
Avatar
Emile63
Bonjour a tous,

Je vous remercie tous pour votre aide active.
Le problème est résolu et ça fonctionne comme je l'espérais. :-))
Ce petit "Parent" plaçé avant "Adress" m'a bien déboussolé..
Heureusement qu'Isabelle nous à ouvert la piste.

Encore merci à tous, ;-))
Cordialement,
Emile
Avatar
Fredo P.
Ex avec en + un DisplayAlerts à False & Sheets("FeuilFormulas ").Delete
pour pouvoir répéter la proc sans message impromptu.
http://cjoint.com/?jrrTvPh2NR

Public Sub Hyperinfo()
Dim Z As Range
Dim N, I As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False ' peut être supprimé si l'obtention du
message lors de la suppression
' de la
'Selection.CurrentRegion.Select '<<<<<<<<<<<à adapter
Set Z = [F10:K100] ' <<<<<<<<<<<à adapter
N = Z.Hyperlinks.Count
Sheets("FeuilFormulas ").Delete
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
Columns("A:D").AutoFit
ActiveSheet.Range("A1").Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
"Emile63" a écrit dans le message de news:

Bonjour Isabelle et Fredo,
Merci pour vos solutions. ;-)

Par rapport a Asterix et Obelix, je me verrais plutôt dans le rôle
d'un légionnaire.... :-))
Je prends les coups parceque quelqu'un devait bien être là, et les
prendres...
Mais avec la naïveté de celui qui ne sais pas ce qu'il l'attends.
Hi, hi, hi..
J'avoue que bien que j'ai compris le rôle de la "Boucle" que propose
Isabelle, je vois pas bien ou la placer pour la mettre en action dans
ton code...
Un dernier coup de main ?? :-)
Merci encore à vous deux,
Cordialement,
Emile
Avatar
isabelle
salut Fredo,

si je suis tombé dedans c'est surement dans la cuve de mon ange du beaujolais de l'auvergna..aa,
bise à toi Fredo, et aux disparus.

isabelle

Le 2010-09-17 07:15, Fredo P. a écrit :
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
Avatar
Fredo P.
"isabelle" a écrit dans le message de news:
i714bm$f46$
salut Fredo,

si je suis tombé dedans c'est surement dans la cuve de mon ange du
beaujolais de l'auvergna..aa,
bise à toi Fredo, et aux disparus.


Disparus?, tsunami?, vie meilleur ailleurs? Lacheurs oui. D'un coté, l'on
peut comprendre leur lassitude du forrum MPFE , alors que l'on aurrait pu
penser que cette activité leurs fussent une détente, un plaisir d'y
participer et espérer avoir de temps en temps une de leurs visites. Peut
être que depuis ce blackout ils découvrent une autre vie, loin de ce qu'ils
aurraient pu imaginer, copines, mariages, divorces, bricolages, voyages en
bus, beuvries, qui sait?

isabelle

Le 2010-09-17 07:15, Fredo P. a écrit :
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
Avatar
michdenis
Et d'ajouter,

Le fait de maintenir 3 groupes de discussion augmente sûrement le dynamisme de ces derniers.
Peut-être devrions-nous demander de séparer les questions et demandant de créer 3 nouveaux forums, ceux concernant
l'interface de calcul et ceux concernant le VBA...
6 groupes de discussions, on serait sûr que tout le monde est servi !

--
MichD
--------------------------------------------


"Fredo P." a écrit dans le message de groupe de discussion :
i72d8c$lgp$

"isabelle" a écrit dans le message de news:
i714bm$f46$
salut Fredo,

si je suis tombé dedans c'est surement dans la cuve de mon ange du
beaujolais de l'auvergna..aa,
bise à toi Fredo, et aux disparus.


Disparus?, tsunami?, vie meilleur ailleurs? Lacheurs oui. D'un coté, l'on
peut comprendre leur lassitude du forrum MPFE , alors que l'on aurrait pu
penser que cette activité leurs fussent une détente, un plaisir d'y
participer et espérer avoir de temps en temps une de leurs visites. Peut
être que depuis ce blackout ils découvrent une autre vie, loin de ce qu'ils
aurraient pu imaginer, copines, mariages, divorces, bricolages, voyages en
bus, beuvries, qui sait?

isabelle

Le 2010-09-17 07:15, Fredo P. a écrit :
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
Avatar
Fredo P.
Peut-être devrions-nous demander de séparer les questions et demandant de
créer 3 nouveaux forums, ceux concernant
l'interface de calcul et ceux concernant le VBA...
6 groupes de discussions, on serait sûr que tout le monde est servi !



Je n'ai pas trop opinion sur cet idée, ce qui est clair, pour des questions
posées de même nature, il y a 3 forums, depuis l'arrêt des news Microsoft,
j'ai utilisé Answers (trop long à démarrer) puis ensuite Ponx.fr que je
côtoyé parfois et plus facilement news-aioe parce que ciblé sur Excel avec
OE comme logiciel de messagerie ce qui ne me change pas des news.Microsoft.
Heureusement pour vous les MVP que vous n'êtes pas obligé d'aller d'un forum
à l'autre en mobylette, je verrais mal la petite Isabelle venant de tomber
dans la cuve de beaujolais reprendre le guidon! :o)))
Avatar
michdenis
à cette adresse, tu peux télécharger : Community Forums NNTP Bridge (Version 40)
http://communitybridge.codeplex.com/releases/view/49451

Ce seul petit utilitaire donne accès à tous les forums
"Answers", "Microsoft", Msdn et Technet.

De plus, à chaque ouverture de Windows, il prend place automatiquement,
nul besoin pour l'usager d'activer quoi que ce soit ou de le lancer manuellement !

Résultat, tu accèdes aux divers forums comme auparavant sur MPFE et l'interface
est pour ainsi dire identique à ce qu'on y retrouvait...

Nul besoin d'être MVP, pour ça !

Sur le site internet de Misange : http://www.excelabo.net/
Il y a un tutoriel quant à la manière d'en faire l'installation.

En conséquence, ton argumentaire ne tient plus !
Mais je reconnais à tous le droit d'en faire qu'à leur tête et
d'intervenir où cela leur tente!

--
MichD
--------------------------------------------


"Fredo P." a écrit dans le message de groupe de discussion :
i73kae$gas$

Peut-être devrions-nous demander de séparer les questions et demandant de
créer 3 nouveaux forums, ceux concernant
l'interface de calcul et ceux concernant le VBA...
6 groupes de discussions, on serait sûr que tout le monde est servi !



Je n'ai pas trop opinion sur cet idée, ce qui est clair, pour des questions
posées de même nature, il y a 3 forums, depuis l'arrêt des news Microsoft,
j'ai utilisé Answers (trop long à démarrer) puis ensuite Ponx.fr que je
côtoyé parfois et plus facilement news-aioe parce que ciblé sur Excel avec
OE comme logiciel de messagerie ce qui ne me change pas des news.Microsoft.
Heureusement pour vous les MVP que vous n'êtes pas obligé d'aller d'un forum
à l'autre en mobylette, je verrais mal la petite Isabelle venant de tomber
dans la cuve de beaujolais reprendre le guidon! :o)))
1 2 3