Code pour créer lien hypertexte dans fichier excel

pascalou83400 Messages postés 285 Date d'inscription   Statut Membre Dernière intervention   -  
pascalou83400 Messages postés 285 Date d'inscription   Statut Membre Dernière intervention   -
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

  1. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    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
    1. pascalou83400 Messages postés 285 Date d'inscription   Statut Membre Dernière intervention  
       
      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