Microsoft 365 Lien hypertexte...

[WEIDER]

Bonjour à tous,

Voilà, je suis carrément bloqué, sur une petite chose en rapport à des liens hypertextes, et je ne sais vraiment pas comment m'y prendre....
Auriez-vous une solution à m'apporter ?

--> Tout est expliqué dans mon fichier joint.

D'avance un grand merci à tous d'avance, pour vos réponses !

Excellente fin de semaine.

 

[job75]

Salut Job75, c'est nouveau ça !?
Si tu mets dans la fonction le lien vers un fichier ou dossier, je puis t'assurer qu'en cliquant dessus ça t'ouvre bien le fichier ou dossier
Cette fonction à en plus le gros avantage (à mes yeux) de ne pas changer le lien qui est dedans 😜

C'est pas nouveau, créez un fichier avec 2 feuilles Feuil1 et Feuil2.

Entrez en Feuil1!A1 la formule =LIEN_HYPERTEXTE("#Feuil2!A1";"Lien")

Pas de problème le lien fonctionne.

Mais exécutez la macro :

Sub test()
MsgBox Feuil1.[A1].Hyperlinks.Count
End Sub

on voit qu'il n'y a pas de vrai lien hypertexte en Feuil1!A1.

 

[job75]

Pour revenir au code VBA notez qu'on peut se passer de bouton.

En complétant la macro évènementielle Worksheet_Change existante :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim h As Hyperlink
Application.EnableEvents = False
Set Target = Intersect(Target, [J7:J37])
If Not Target Is Nothing Then
    For Each Target In Target 'si entrées multiples (copier-coller)
        Target.Font.Color = IIf(Target = "bas", vbRed, vbGreen)
        Target = IIf(Target = "bas", "ê", IIf(Target = "haut", "é", ""))
    Next Target
End If
Application.ScreenUpdating = False
For Each h In Columns("AH").Hyperlinks
        h.TextToDisplay = "Lien"
        h.Parent.HorizontalAlignment = xlCenter 'centrage
Next h
Application.EnableEvents = True
End Sub

Les liens en colonne AH sont modifiés quand ils sont créés ou quand on modifie/valide une cellule quelconque.

 

[WEIDER]

job75 ! Parfait !
Voilà qui réponds à 100% à ma demande initiale ! Je créé le lien, et au moment de le valider, celui-ci ce mets automatiquement au format que je souhaite !
Bravo et merci pour le partage de votre savoir.
Bon samedi à tous !

 

[job75]

Utilisez plutôt ceci, c'est plus rapide :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim h As Hyperlink
Application.EnableEvents = False
Set Target = Intersect(Target, [J7:J37])
If Not Target Is Nothing Then
    For Each Target In Target 'si entrées multiples (copier-coller)
        Target.Font.Color = IIf(Target = "bas", vbRed, vbGreen)
        Target = IIf(Target = "bas", "ê", IIf(Target = "haut", "é", ""))
    Next Target
End If
Application.ScreenUpdating = False
With Columns("AH")
    For Each h In .Hyperlinks
        h.TextToDisplay = "Lien"
    Next h
    .HorizontalAlignment = xlCenter 'centrage
    .Font.Size = 16 'taille de police
End With
Application.EnableEvents = True
End Sub

Testée chez moi avec 1000 liens hypertextes => 0,06 seconde.
Avec 10 000 liens hypertextes => 1,6 seconde.

 

[job75]

Bonjour WEIDER, le forum,

En fait 1,6 seconde pour 10 000 liens c'est beaucoup trop car cela se répète à chaque modification de la feuille.

Cette macro utilise le filtre automatique pour ne traiter que les liens hypertextes qui n'affichent pas "Lien" :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim h As Hyperlink
Application.EnableEvents = False
Set Target = Intersect(Target, [J7:J37])
If Not Target Is Nothing Then
    For Each Target In Target 'si entrées multiples (copier-coller)
        Target.Font.Color = IIf(Target = "bas", vbRed, vbGreen)
        Target = IIf(Target = "bas", "ê", IIf(Target = "haut", "é", ""))
    Next Target
End If
Application.ScreenUpdating = False
With Range("AH1:AH" & Cells.SpecialCells(xlCellTypeLastCell).Row)
    .AutoFilter 1, "<>Lien" 'filtre automatique
    For Each h In .SpecialCells(xlCellTypeVisible).Hyperlinks
        h.TextToDisplay = "Lien"
    Next h
    .AutoFilter 'ôte le filtre
    .HorizontalAlignment = xlCenter 'centrage
    .Font.Size = 16 'taille de police
End With
Application.EnableEvents = True
End Sub

En général un seul lien est traité (celui qui vient d'être créé) et c'est donc instantané.

A+

 

[WEIDER]

Encore une fois, bravo (et merci) pour cette nouvelle mouture jopb75 !

 

[job75]

Dans la macro précédente je viens d'enlever l'instruction On Error Resume Next 'si aucune SpecialCell.

Car la 1ère cellule du filtre AH1 est toujours visible et cette instruction est donc inutile.

 

[wDog66]

@WEIDER désolé, de revenir "polluer" le fil 😜

C'est pas nouveau, créez un fichier avec 2 feuilles Feuil1 et Feuil2.

Entrez en Feuil1!A1 la formule =LIEN_HYPERTEXTE("#Feuil2!A1";"Lien")

Pas de problème le lien fonctionne.

Mais exécutez la macro :

Sub test()
MsgBox Feuil1.[A1].Hyperlinks.Count
End Sub

on voit qu'il n'y a pas de vrai lien hypertexte en Feuil1!A1.

Salut @job75,
Je comprends mieux 🤭 mais tout dépend jusqu'ou on veut aller avec les les liens hypertexte

L'avantage incontestable pour moi, c'est que le lien dans la formule ne change jamais, on peut donc utiliser le fichier sur n'importe quel PC avec liens vers le serveur d'une société

Et avec un code comme celui-ci, on peut facilement retrouver les cellules

Sub DetecterLienHypertexteFormule()
    Dim ws As Worksheet
    Dim cell As Range
    Dim plage As Range

    Set ws = ThisWorkbook.Sheets("NomFeuille")
    Set plage = ws.UsedRange ' ou une plage spécifique : ws.Range("A1:Z100")

    For Each cell In plage
        If cell.HasFormula Then
            If InStr(1, cell.Formula, "LIEN.HYPERTEXTE", vbTextCompare) > 0 Then
                Debug.Print "Lien trouvé dans la cellule " & cell.Address & " : " & cell.Formula
            End If
        End If
    Next cell
End Sub

Ceci dit, en général la formule LIEN.HYPERTEXTE() est dans une colonne bien attribué, il est donc inutile de parcourir toute une feuille
Il suffit juste de parcourir la cellule en question

Bon développement à notre Xldien