Macro transformants les hyperliens text en hyperliens cliquables

Le
M
Bonjour,

J'ai absolument besoin de votre aide pour transformer une macro
trouvée sur le net.
J'ai un classeur contenant des hyperliens et du texte standard.
Les hyperliens ne sont actuellement pas cliquables.
J'ai besoin que cette macro teste la feuille active pour y trouver les
hyperliens et qu'elle les rende tous cliquables s'ils ne le sont pas
déjà.

En gros, la page contiendrait


A B C D
1 texte divers
2 http://www.monlien.fr texte divers 2
3 texte divers3 http://www.monlien2.com
4 http://www.monlien4.fr texte divers4 texte divers5


etc

Actuellement, j'en suis arrivé à un script qui est composé comme
suit :

Sub AddHyperlinks()

Dim rLastCell As Range
Dim Cell As Range

Set rLastCell = Worksheets("ActiveSheet").Range("A" &
Cells.Rows.Count).End(xlUp)

For Each Cell In Range("A1", rLastCell)
If Not IsEmpty(Cell) Then _
Cell.Hyperlinks.Add Cell, Cell.Text, TextToDisplay:="Click
to View"
Next Cell

End Sub


Mon souci est qu'il n'y a pas de test conditionnel vérifiant que la
cellule contient bien un lien (qui commence toujours par http).

Je ne connais pas bien les macros mais je verrais un truc qui ferait

Sub AddHyperlinks() ' validation liens d'une colonne

Dim rLastCell As Range
Dim Cell As Range

Set rLastCell = Worksheets("ActiveSheet").Range("A" &
Cells.Rows.Count).End(xlUp)

For Each Cell In Range("A1", rLastCell)
**** If (Cell) begins with "http" Then _ *****
Cell.Hyperlinks.Add Cell, Cell.Text, TextToDisplay:="Click
to View"
Next Cell




End Sub

Pouvez-vous m'aider?
Evidemment, j'en ai besoin pour hier :)

Merci d'avance!
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
FFO
Le #18425351
Salut à toi

Mets ceci :


For Each Cell In Range("A1", rLastCell)
If cell like "http*" Then
Cell.Hyperlinks.Add Cell, Cell.Text, TextToDisplay:="Click
to View"
End If
Next Cell

Celà devrait convenir

Dis moi !!!!
M
Le #18425631
Je laisse une partie de mon code ou pas?
Parce que j'ai juste mis le tien mais ça ne marche pas.
Tu peux me filer le code complet?

Merci

On 19 jan, 11:21, FFO
Salut à toi

Mets ceci :

For Each Cell In Range("A1", rLastCell)
If cell like "http*" Then
Cell.Hyperlinks.Add Cell, Cell.Text, TextToDisplay:="Click
to View"
End If
Next Cell

Celà devrait convenir

Dis moi !!!!


M
Le #18425621
J'ai mis ceci :
Sub AddHyperlinks()

Dim rLastCell As Range
Dim Cell As Range

Set rLastCell = Worksheets("ActiveSheet").Range("A" &
Cells.Rows.Count).End(xlUp)

For Each Cell In Range("A1", rLastCell)
If Cell Like "http*" Then _
Cell.Hyperlinks.Add Cell, Cell.Text, TextToDisplay:="Click
to View"
Next Cell

End Sub

Je n'ai plus de message mais rien ne se passe.
J'ai omis de dire que le contenu des cellules étaient une formule qui
créait un lien. Pas un lien direct.
Ca change qqchose?

Par exemple, une des cellules contient : =Modèle!$B$5&B$3&$B$9&B
$4&Modèle!$D$5

Du coup, j'ai essayé de transformer le code plus haut en changeant la
ligne :

If Cell Like "=Modèle*" Then _

Aucun résultat...



On 19 jan, 12:05, ""
Je laisse une partie de mon code ou pas?
Parce que j'ai juste mis le tien mais ça ne marche pas.
Tu peux me filer le code complet?

Merci

On 19 jan, 11:21, FFO
> Salut à toi

> Mets ceci :

> For Each Cell In Range("A1", rLastCell)
> If cell like "http*" Then
> Cell.Hyperlinks.Add Cell, Cell.Text, TextToDisplay:="Click
> to View"
> End If
> Next Cell

> Celà devrait convenir

> Dis moi !!!!


FFO
Le #18426401
Rebonjour à toi

J'ai fait un essai chez moi en mettant des formules du type

þuil2!A1
þuil2!A2
þuil2!A3
þuil2!A4

avec chacune de ces cellules en Feuil2 possédant un lien hypertexte

Sur chacune des cellules ayant la formule ci-dessus le lien correspondant en
Feuil2 est ramené

Avec ta macro le lien est bien créé sur ces cellules

N'y a t'il pas un caractère parasite style espace en début de chaque lien ????

Tu peux essayer de mettre :

If Cell Like "*http*" Then

et si celà fonctionne celà voudra dire que devant le http de chaque lien il
y a un élément supplémentaire

Peut être aussi un problème de casse (Http ou HTTP etc....)
A vérifier

Tu peux aussi me transmettre tout ou parti de ton document pour que je
l'étudie :

http://www.cijoint.fr/index.php

Communiques moi le lien pour le récupérer
M
Le #18426871
J'ai trouvé! (enfin... on m'a aidé hein ;) )
Voici le code :

Sub AddHyperlinks()

Dim rLastCell As Range
Dim Cell As Range

Set rLastCell = ActiveSheet.Range("Z50")

For Each Cell In Range("A1", rLastCell)
If Not IsEmpty(Cell) And InStr(1, Cell.Text, "http:") <> 0
Then _
Cell.Hyperlinks.Add Cell, Cell.Text, TextToDisplay:="Click to
View"
Next Cell

End Sub

Merci pour ton aide!

On 19 jan, 13:52, FFO
Rebonjour à toi

J'ai fait un essai chez moi en mettant des formules du type

þuil2!A1
þuil2!A2
þuil2!A3
þuil2!A4

avec chacune de ces cellules en Feuil2 possédant un lien hypertexte

Sur chacune des cellules ayant la formule ci-dessus le lien correspondant en
Feuil2 est ramené

Avec ta macro le lien est bien créé sur ces cellules

N'y a t'il pas un caractère parasite style espace en début de chaque lien ????

Tu peux essayer de mettre :

 If Cell Like "*http*" Then

et si celà fonctionne celà voudra dire que devant le http de chaque l ien il
y a un élément supplémentaire

Peut être aussi un problème de casse (Http ou HTTP etc....)
A vérifier

Tu peux aussi me transmettre tout ou parti de ton document pour que je
l'étudie  :

http://www.cijoint.fr/index.php

Communiques moi le lien pour le récupérer


FFO
Le #18427171
Rebonjour à toi

Ta solution me confirme que tes liens ne commence pas par http mais par un
ou plusieurs caractères précédant http

Ma solution donc avec :

If Cell Like "*http*" Then

devait fonctionner

ta condition :

"Mon souci est qu'il n'y a pas de test conditionnel vérifiant que la
cellule contient bien un lien (qui commence toujours par http).
"

n'est pas exacte

D'où ma première proposition inadaptée

Essaies d'être plus rigoureux la prochane fois

A bientôt peut être
Publicité
Poster une réponse
Anonyme