A voir également:
- Vba lien hypertexte vers fichier
- Fichier bin - Guide
- Lien copié - Forum Téléphones & tablettes Android
- Fichier epub - Guide
- Lien url - Guide
- Fichier rar - Guide
10 réponses
Bonjour,
Voilà un code à adapter à la feuille et à la colonne :
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
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.