XL 2016 RECHERCHE D'UNE MACRO CONCERNTANT LES LIENS HYPERTEXTES

[PACKYMAITRE]

Bonjour,

J’ai à peu près une centaine de liens hypertextes dans mon sommaire et j’ai supprimé une vingtaine onglets inutiles.

Exemple :

Dans mon sommaire de liens hypertextes : PRINTEMPS, ETE, AUTONOME et HIVER
J’ai supprimé l’onglet « ETE »
Dans mon sommaire, quand je clique sur « ETE », il me marque « Référence non valide »
Je désirerai qu’il me reste dans mon sommaire : PRINTEMPS, AUTONOME et HIVER avec les liens hypertextes

C’est pourquoi je suis à la recherche d’une macro qui permettra dans mon sommaire de supprimer les liens hypertextes et les commentaires obsolètes.


Bien à vous,
Packymaitre

 

[job75]

Bonsoir PACKYMAITRE,

Exécutez cette macro :

Sub SupprimerLiens()
Dim h As Hyperlink
For Each h In Sheets("Sommaire").Hyperlinks
    If h.Address = "" Then If TypeName(Evaluate(h.SubAddress)) <> "Range" Then h.Parent.Clear
Next
End Sub

A+

 

[fanch55]

Bonsoir, à tester :

Sub Check_Hyper()
Dim H As Hyperlink

    For Each H In ActiveSheet.Hyperlinks
        ' MsgBox H.Range.Address
        Select Case True
            Case H.Address <> vbNullString:   ' on ne traite pas les adresses Web
            Case IsError(Evaluate(H.SubAddress)):  H.Range = vbNullString ' détruit l'hyperlink
        End Select
    Next

End Sub

@job75 : on s'est croisé ... 🤭

 

[PACKYMAITRE]

Bonsoir PACKYMAITRE,

Exécutez cette macro :

Sub SupprimerLiens()
Dim h As Hyperlink
For Each h In Sheets("Sommaire").Hyperlinks
    If h.Address = "" Then If TypeName(Evaluate(h.SubAddress)) <> "Range" Then h.Parent.Clear
Next
End Sub

A+

Merci pour ton aide, impeccable

 

[job75]

Bonsoir fanch55,

C'est en effet plus simple avec IsError :

Sub SupprimerLiens()
Dim h As Hyperlink
For Each h In Sheets("Sommaire").Hyperlinks
    If h.Address = "" Then If IsError(Evaluate(h.SubAddress)) Then h.Parent.Clear
Next
End Sub

A+

 

[PACKYMAITRE]

Bonsoir, à tester :

Sub Check_Hyper()
Dim H As Hyperlink

    For Each H In ActiveSheet.Hyperlinks
        ' MsgBox H.Range.Address
        Select Case True
            Case H.Address <> vbNullString:   ' on ne traite pas les adresses Web
            Case IsError(Evaluate(H.SubAddress)):  H.Range = vbNullString ' détruit l'hyperlink
        End Select
    Next

End Sub

@job75 : on s'est croisé ... 🤭

Merci pour ton aide, impeccable

Bonsoir PACKYMAITRE,

Exécutez cette macro :

Sub SupprimerLiens()
Dim h As Hyperlink
For Each h In Sheets("Sommaire").Hyperlinks
    If h.Address = "" Then If TypeName(Evaluate(h.SubAddress)) <> "Range" Then h.Parent.Clear
Next
End Sub

A+

 

[PACKYMAITRE]

Merci pour votre aide, impeccable.
Packymaitre