Code pour créer lien hypertexte dans fichier excel

Fermé
pascalou83400
Messages postés
273
Date d'inscription
dimanche 20 juillet 2014
Statut
Membre
Dernière intervention
24 janvier 2022
- 8 nov. 2017 à 09:36
pascalou83400
Messages postés
273
Date d'inscription
dimanche 20 juillet 2014
Statut
Membre
Dernière intervention
24 janvier 2022
- 12 nov. 2017 à 11:05
Bonjour,

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.

Merci pour votre aide.

Pascal



10 réponses

cs_Le Pivert
Messages postés
7752
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
26 mai 2022
710
8 nov. 2017 à 13:46
Bonjour,

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


0
pascalou83400
Messages postés
273
Date d'inscription
dimanche 20 juillet 2014
Statut
Membre
Dernière intervention
24 janvier 2022

8 nov. 2017 à 18:21
Bonjour cs_Le Pivert,

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.
0