Je récupérer via une requête des liens URL dans un fichier excel, mais je voudrai les mettre en hypertexte.
J'ai déjà une boucle dans ce fichier qui me permet d’exécuter différentes macros, mais je ne sais pas comment faire pour que ma colonne avec les URL devienne hypertexte.
Voilà un code à adapter à la feuille et à la colonne :
Option Explicit
Dim FL1 As Worksheet, NoCol As Integer
Dim NoLig As Long
Dim derniereLigne
Dim var As String
Sub creerlien() 'lien hypertexte
Set FL1 = Worksheets("Feuil1") 'a adapter
NoCol = 1 'lecture de la colonne A
derniereLigne = Range("A" & Rows.Count).End(xlUp).Row 'n° de la dernière ligne non vide de la colonne
For NoLig = 1 To derniereLigne
var = FL1.Cells(NoLig, NoCol)
FL1.Cells(NoLig, NoCol).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
var _
, TextToDisplay:= _
var
Next
Set FL1 = Nothing
End Sub
Sub supprimer() 'supprimer lien hypertexte
Set FL1 = Worksheets("Feuil1") 'a adapter
NoCol = 1 'lecture de la colonne A
derniereLigne = Range("A" & Rows.Count).End(xlUp).Row 'n° de la dernière ligne non vide de la colonne
For NoLig = 1 To derniereLigne
var = FL1.Cells(NoLig, NoCol)
FL1.Cells(NoLig, NoCol).Select
Selection.Hyperlinks.Delete
Next
Set FL1 = Nothing
End Sub
Je viens de lire ton code, je l'ai modifié avec la ligne A18 ou commence mon tableau et ou se trouve les URL que j'ai récupéré via la requête et la colonne N qui est la 14 et j'ai plusieurs feuilles à traiter.
j'ai modifié avec mes données et je l'ai mis dans une macro, cela marche, mais je suis déjà dans une boucle qui m'a été fait par un informaticien, que je modifie quand je veux rajouter qq choses.
ton code modifié avec mes données
Option Explicit
Dim FL1 As Worksheet, NoCol As Integer
Dim NoLig As Long
Dim derniereLigne
Dim var As String
Sub creerlien() 'lien hypertexte
Set FL1 = Worksheets("PM Tarif_T3") 'a adapter
NoCol = 14 'lecture de la colonne A
derniereLigne = Range("N" & Rows.Count).End(xlUp).Row 'n° de la dernière ligne non vide de la colonne
For NoLig = 18 To derniereLigne
var = FL1.Cells(NoLig, NoCol)
FL1.Cells(NoLig, NoCol).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
var _
, TextToDisplay:= _
var
Next
Set FL1 = Nothing
End Sub
Sub supprimer() 'supprimer lien hypertexte
Set FL1 = Worksheets("PM Tarif_T3") 'a adapter
NoCol = 14 'lecture de la colonne A
derniereLigne = Range("N" & Rows.Count).End(xlUp).Row 'n° de la dernière ligne non vide de la colonne
For NoLig = 18 To derniereLigne
var = FL1.Cells(NoLig, NoCol)
FL1.Cells(NoLig, NoCol).Select
Selection.Hyperlinks.Delete
Next
Set FL1 = Nothing
End Sub
Je ne sais pas l'inclure dans ma boucle, j'ai déjà un code qui balaye une colonne et je n'arrive pas à adapter le tient pour le rendre valide.
ci-joint le code
' Met les cellule en vert dans la colonne C si dans Colonne AK = "Notre Sélection"
Dim PL As Range
Dim PLV As Range
Dim Cel As Range
'Nom de feuille à adapter ' ActiveWorkbook.Worksheets("Feuil1")'
With Worksheets(I)
'Balayage de la colonne A18/fin, jusqu'à la dernière cellule renseignée
For Each Cel In .Range("AK18:AK" & .Range("AK" & Rows.Count).End(xlUp).Row)
'Si la cellule contient "Notre Sélection"
If Cel.Value = "Notre Sélection" Then
'alors, remplir la cellule correspondante en colonne A/D en vert
.Cells(Cel.Row, 1).Resize(1, 26).Font.ColorIndex = xlAutomatic ' Interior.ColorIndex = 4
.Cells(Cel.Row, 1).Resize(1, 26).Font.Bold = True
.Cells(Cel.Row, 1).Resize(1, 26).Font.Italic = True
.Cells(Cel.Row, 1).Resize(1, 26).Font.Size = 57 ' (souligné).Font.Underline = xlUnderlineStyleSingle
Else
' mais si il n'y a pas Notre Selection alors on met un fond neutre
.Cells(Cel.Row, 3).Resize(1, 26).Font.ColorIndex = xlAutomatic '.Interior.ColorIndex = xlNone
.Cells(Cel.Row, 3).Resize(1, 26).Font.Bold = False
.Cells(Cel.Row, 1).Resize(1, 26).Font.Italic = False
.Cells(Cel.Row, 1).Resize(1, 26).Font.Size = 55 ' .Font.Underline = xlUnderlineStyleSingleNone(non souligné)
End If
Next Cel
End With
Bon j’espère que je n'abuse pas avec toutes mes demandes ?
Oui pour ce code je n'ai pas de problème, je voulais m'en inspirer pour mettre ton code dans ma boucle existante, mais je n'arrive pas à le modifier, peux tu m'aider à le modifier pour qu'il tourne dans ma boucle stp.
Je cherche comment mettre ""PHOTO"" à la place du nom du lien.
Ce n'est pas possible ta boucle sert pour récupérer les cellules qui ont
" Notre Sélection" pour changer de couleur et de police.
Pour ce que tu veux faire il y a 2 manières
Tu mets:
Je récupérer via une requête des liens URL dans un fichier excel,
1: tu peux ajouter a ce code le code des liens hypertextes
Tu mets aussi ceci:
j'ai plusieurs feuilles à traiter.
2: voila donc une macro qui te servira pour toute tes feuilles, il suffira de l'appeler avec le nom de la feuille et de la colonne à traiter:
Sub creerlienhyper(ByVal mafeuille As String, colonne As Integer) 'lien hypertexte
Dim FL1 As Worksheet
Dim NoLig As Long
Dim derniereLigne
Dim var As String
Dim lettre As String
lettre = Split(Cells(, colonne).Address, "$")(1) 'numero colonne en lettre
Set FL1 = Worksheets(mafeuille)
derniereLigne = Range(lettre & Rows.Count).End(xlUp).Row 'n° de la dernière ligne non vide de la colonne
For NoLig = 1 To derniereLigne
var = FL1.Cells(NoLig, colonne)
FL1.Cells(NoLig, colonne).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
var _
, TextToDisplay:= _
var
Next
Set FL1 = Nothing
End Sub
et pour l'appeler:
Call creerlienhyper("Feuil2", "5") 'adapter nom de la feuille et de la colonne
Oups la je galère je suis novice et je peine à suivre.
Je me suis mal expliqué, je ne veux pas mettre ton code dans cette boucle, celle ci me sert pour sélectionner les ligne avec " Notre Sélection" et elle est dans une boucle générale.
Mon problème est que j'ai fait des boucles dans la boucle à force d'alimenter mon code de départ, comme je suis novice je bidouille comme je peux.
Si tu veux je peux mettre mon fichier en ligne, mais je pense que tu vas prendre peur du développement que j'ai fait.
Je cherche à mettre ton 1er code qui fonctionne à merveille dans ma boucle générale comme celle de " Notre Sélection" qui était juste en exemple pour que tu vois comment cela se présentait.
Je sais que mes explications ne sont pas toujours bien claires, désolé.
Mais c'est génial j'apprends au fur et mesure, une fois que j'ai compris le code...
ci-joint mon fichier c'est le module3 mon code en boucle
Génial ça marche, mais j'ai juste une erreur execution 1004 la methode range de l'objet global a echoue sur cette ligne et je n'arrive pas à solutionner.
Ce n'est pas une bonne idée de mettre la création des liens à chaque fois que tu cliques sur le bouton.
Je t'ai fait 2 boutons supplémentaires: création du lien avec le Nom "PHOTO" et suppression pour que tu retrouves le chemin du lien sinon tu le perds quand tu mets "PHOTO":
je n'ai pas regardé le code, mais je génère toutes les semaines mes requêtes, car mon disponible change toutes les semaines, donc je dois refaire à chaque fois mes feuilles pour refaire toutes les macros.
Chez moi le classeur fonctionne très bien, je ne peux pas faire plus.
Je te donne le code pour ne mettre le lien que dans le cellule avec du texte:
Sub creerlien() 'lien hypertexte
Application.ScreenUpdating = False
Set FL1 = Worksheets("PM Tarif_T3") 'a adapter
NoCol = 14 'lecture de la colonne N
derniereLigne = Range("N" & Rows.Count).End(xlUp).Row 'n° de la dernière ligne non vide de la colonne
For NoLig = 18 To derniereLigne
var = FL1.Cells(NoLig, NoCol)
If var = "" Then
'on ne met rien c'est simple!!!!!!!
Else
FL1.Cells(NoLig, NoCol).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
var _
, TextToDisplay:= _
"PHOTO"
End If
Next
Set FL1 = Nothing
Application.ScreenUpdating = True
End Sub
donc mettre ce code dans le module2 à la place de l'autre. Tu creeras tes liens sur toutes les feuilles et ensuite tu pourras cliquer sur ton bouton:
Option Explicit
Dim FL1 As Worksheet, NoCol As Integer
Dim NoLig As Long
Dim derniereLigne
Dim var As String
Dim lettre As String
Sub creerlienhyper(ByVal mafeuille As String, colonne As Integer) 'lien hypertexte
Application.ScreenUpdating = False
lettre = Split(Cells(, colonne).Address, "$")(1) 'numero colonne en lettre
Set FL1 = Worksheets(mafeuille)
derniereLigne = Range(lettre & Rows.Count).End(xlUp).Row 'n° de la dernière ligne non vide de la colonne
For NoLig = 18 To derniereLigne
var = FL1.Cells(NoLig, colonne)
If var = "" Then
'on ne fait rien
Else
FL1.Cells(NoLig, colonne).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
var _
, TextToDisplay:= _
"PHOTO"
End If
Next
Set FL1 = Nothing
Application.ScreenUpdating = True
End Sub
Sub creerlien()
Dim f As Worksheet
For Each f In ActiveWorkbook.Worksheets
If f.Name = "Données commerciales" Then
'on ne fait rien
Else
Sheets(f.Name).Activate
Call creerlienhyper(f.Name, "14") 'adapter nom de la feuille et de la colonne
End If
Next f
Worksheets("PM Tarif_T3").Activate
End Sub
Ok je te remercie je préfères 1 seul bouton pour tout faire , comme j'écrase tout à chaque fois et que j'ai une dizaine de fichier fournisseurs ca va plus vite.
Je vais mettre ton code dans ma boucle et je vois.
Option Explicit
Dim FL1 As Worksheet, NoCol As Integer
Dim NoLig As Long
Dim derniereLigne
Dim var As String
Dim lettre As String
Sub creerlienhyper(ByVal mafeuille As String, colonne As Integer) 'lien hypertexte
Application.ScreenUpdating = False
lettre = Split(Cells(, colonne).Address, "$")(1) 'numero colonne en lettre
Set FL1 = Worksheets(I)
derniereLigne = Range(lettre & Rows.Count).End(xlUp).Row 'n° de la dernière ligne non vide de la colonne
For NoLig = 18 To derniereLigne
var = FL1.Cells(NoLig, colonne)
If var = "" Then
'on ne fait rien
Else
FL1.Cells(NoLig, colonne).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
var _
, TextToDisplay:= _
"PHOTO"
End If
Next
Set FL1 = Nothing
Application.ScreenUpdating = True
et je l’appelle dans mon module3 qui est ma boucle avec Call Module1.creerlienhyper, ca bug, il me dit erreur compilation argument non facultatif.
Tu n'as pas tout recopier dans le dernier code que je t'ai donné!
Il manque la Sub creerlien()
Il faut quand même essayer de comprendre ce que l'on fait.
Il y a une macro pour créer les liens et une autre qui parcourt toutes les feuilles pour lancer cette macro!
Ensuite il faut mettre la macro creerlien avant la boucle, comme ceci:
Sub Rognerunrectangleavecuncoindiagonal3_Cliquer()
' Variables globales
Dim nbWS As Integer
Dim totalRows As Integer
Dim totalCols As Integer
Dim CheminFichier As String
Dim NomFichier As String
nbWS = ActiveWorkbook.Worksheets.Count
CheminFichier = "chemin"
creerlien ' on cree les liens hypertextes avant la boucle
For I = 1 To nbWS - 1
Maintenant je vais être clair: ou tu te sers de 2 boutons comme je te le suggère depuis le début et tu perds 2 secondes et tout fonctionnent. Ou tu te sers d'un bouton comme tu y tiens, alors il faudra supprimer cette ligne:
Merci pour ton aide.
Je viens de lire ton code, je l'ai modifié avec la ligne A18 ou commence mon tableau et ou se trouve les URL que j'ai récupéré via la requête et la colonne N qui est la 14 et j'ai plusieurs feuilles à traiter.
j'ai modifié avec mes données et je l'ai mis dans une macro, cela marche, mais je suis déjà dans une boucle qui m'a été fait par un informaticien, que je modifie quand je veux rajouter qq choses.
ton code modifié avec mes données
Option Explicit
Dim FL1 As Worksheet, NoCol As Integer
Dim NoLig As Long
Dim derniereLigne
Dim var As String
Sub creerlien() 'lien hypertexte
Set FL1 = Worksheets("PM Tarif_T3") 'a adapter
NoCol = 14 'lecture de la colonne A
derniereLigne = Range("N" & Rows.Count).End(xlUp).Row 'n° de la dernière ligne non vide de la colonne
For NoLig = 18 To derniereLigne
var = FL1.Cells(NoLig, NoCol)
FL1.Cells(NoLig, NoCol).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
var _
, TextToDisplay:= _
var
Next
Set FL1 = Nothing
End Sub
Sub supprimer() 'supprimer lien hypertexte
Set FL1 = Worksheets("PM Tarif_T3") 'a adapter
NoCol = 14 'lecture de la colonne A
derniereLigne = Range("N" & Rows.Count).End(xlUp).Row 'n° de la dernière ligne non vide de la colonne
For NoLig = 18 To derniereLigne
var = FL1.Cells(NoLig, NoCol)
FL1.Cells(NoLig, NoCol).Select
Selection.Hyperlinks.Delete
Next
Set FL1 = Nothing
End Sub
Je ne sais pas l'inclure dans ma boucle, j'ai déjà un code qui balaye une colonne et je n'arrive pas à adapter le tient pour le rendre valide.
ci-joint le code
' Met les cellule en vert dans la colonne C si dans Colonne AK = "Notre Sélection"
Dim PL As Range
Dim PLV As Range
Dim Cel As Range
'Nom de feuille à adapter ' ActiveWorkbook.Worksheets("Feuil1")'
With Worksheets(I)
'Balayage de la colonne A18/fin, jusqu'à la dernière cellule renseignée
For Each Cel In .Range("AK18:AK" & .Range("AK" & Rows.Count).End(xlUp).Row)
'Si la cellule contient "Notre Sélection"
If Cel.Value = "Notre Sélection" Then
'alors, remplir la cellule correspondante en colonne A/D en vert
.Cells(Cel.Row, 1).Resize(1, 26).Font.ColorIndex = xlAutomatic ' Interior.ColorIndex = 4
.Cells(Cel.Row, 1).Resize(1, 26).Font.Bold = True
.Cells(Cel.Row, 1).Resize(1, 26).Font.Italic = True
.Cells(Cel.Row, 1).Resize(1, 26).Font.Size = 57 ' (souligné).Font.Underline = xlUnderlineStyleSingle
Else
' mais si il n'y a pas Notre Selection alors on met un fond neutre
.Cells(Cel.Row, 3).Resize(1, 26).Font.ColorIndex = xlAutomatic '.Interior.ColorIndex = xlNone
.Cells(Cel.Row, 3).Resize(1, 26).Font.Bold = False
.Cells(Cel.Row, 1).Resize(1, 26).Font.Italic = False
.Cells(Cel.Row, 1).Resize(1, 26).Font.Size = 55 ' .Font.Underline = xlUnderlineStyleSingleNone(non souligné)
End If
Next Cel
End With
Bon j’espère que je n'abuse pas avec toutes mes demandes ?
Encore merci pour ton aide.