XL 2016 RECHERCHE D'UNE MACRO CONCERNTANT LES LIENS HYPERTEXTES

PACKYMAITRE · 16 Novembre 2020

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 · 16 Novembre 2020

Bonsoir PACKYMAITRE,

Exécutez cette macro :

VB:

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 · 16 Novembre 2020

Bonsoir, à tester :

VB:

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 · 16 Novembre 2020

job75 à dit:
Bonsoir PACKYMAITRE,

Exécutez cette macro :

VB:

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 · 16 Novembre 2020

Bonsoir fanch55,

C'est en effet plus simple avec IsError :

VB:

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 · 16 Novembre 2020

fanch55 à dit:

Bonsoir, à tester :

VB:

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

job75 à dit:
Bonsoir PACKYMAITRE,

Exécutez cette macro :

VB:

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 · 16 Novembre 2020

Merci pour votre aide, impeccable.
Packymaitre

XL 2016 RECHERCHE D'UNE MACRO CONCERNTANT LES LIENS HYPERTEXTES

PACKYMAITRE

XLDnaute Nouveau

job75

XLDnaute Barbatruc

fanch55

XLDnaute Barbatruc

PACKYMAITRE

XLDnaute Nouveau

job75

XLDnaute Barbatruc

PACKYMAITRE

XLDnaute Nouveau

PACKYMAITRE

XLDnaute Nouveau

Discussions similaires