XL 2010 Bouton souligner texte et inversément

tchi456

XLDnaute Occasionnel
Bonjour,

Je souhaite créer un bouton qui me change le texte en souligné/pas souligné sur les cellules sélectionnées (feuille verrouillée par mot de passe).

J'imaginais un code comme celui-ci mais il ne fonctionne que dans un sens:$

VB:
'Bouton mettre le texte souligné/pas souligné

Sub BoutonSouligné()
    Dim C As Range
    ActiveSheet.Unprotect Password:="."
    For Each C In Selection
    'boucle sur chaque cas
        If C.Font.Underline = True Then
     C.Font.Underline = False
     Else
     C.Font.Underline = True
     End If
    Next
    ActiveSheet.Protect Password:="."
End Sub

Mes meilleures salutations,

Thierry
 
Solution
Bonjour Tchi456, Phil69970, chris401, fanch55, le forum

Une proposition par cellule :

Cordialement, @+
VB:
Sub Invert_()
    Dim C As Range
    For Each C In Selection: C.Font.Underline = IIf(C.Font.Underline = -4142, 2, -4142): Next C
End Sub

Phil69970

XLDnaute Barbatruc
Bonjour Thierry

Je te propose ceci :
VB:
Sub BoutonSouligné()
Dim C As Range
ActiveSheet.Unprotect Password:="."
For Each C In Selection
'boucle sur chaque cas
    If C.Font.Underline = 2 Then
        C.Font.Underline = 1
    Else
        C.Font.Underline = 2
    End If
Next
ActiveSheet.Protect Password:="."
End Sub

*Merci de ton retour

@Phil69970
 

fanch55

XLDnaute Barbatruc
Salut à tous,
Je ne sais pas ce qu'est un underline = 1 .... 🤔

Champs​

xlUnderlineStyleDouble -4119Double souligné épais.
xlUnderlineStyleDoubleAccounting 5Deux soulignés fins placés côte à côte.
xlUnderlineStyleNone -4142Aucun soulignement.
xlUnderlineStyleSingle 2Soulignement simple.
xlUnderlineStyleSingleAccounting 4Non prise en charge.

VB:
Sub BoutonSouligné()
    Dim C As Range
    ActiveSheet.Unprotect Password:="."
    For Each C In Selection
          If C.Font.Underline <> xlUnderlineStyleNone _
        Then C.Font.Underline = xlUnderlineStyleNone _
        Else C.Font.Underline = xlUnderlineStyleSingle
    Next
    ActiveSheet.Protect Password:="."
End Sub
 

tchi456

XLDnaute Occasionnel
Bonjour à tous,

Merci pour votre aide. En bidouillant un peu j'ai trouvé cette possibilité:

VB:
Sub BoutonSouligné()
    Dim C As Range
    ActiveSheet.Unprotect Password:="."
    For Each C In Selection
    'boucle sur chaque cas
        If C.Font.Underline = xlUnderlineStyleNone Then
     C.Font.Underline = True
     Else
     C.Font.Underline = False
     End If
    Next
    ActiveSheet.Protect Password:="."
End Sub

Bonne journée!
 

patricktoulon

XLDnaute Barbatruc
re
Bonjour
alala lalala !!!!
pourquoi boucler sur toutes les cellules
la propriété font est un membre de range ;range qui peut etre une cellule ou plusieures ;)


attention au resultat true false meme si notre cher VBA est tolerant avec notre façon de voir tout faux ou vrai(false/true)
la propriété renvoie en fait EN LECTURE
  • -4419 pour le double souligné
  • 2 pour le souligné simple
  • -4142 pour le non souligné
alors en dessous 0 ca renvoie false alors que le double souligné est en dessous zero

ma conclusion
on envoie en false uniquement pour l'enlever et non pour le lire
et on l'applique a la selection en 1 coup

Code:
Private Sub CommandButton1_Click()
    With Selection.Font
        .Underline = IIf(.Underline = 2, False, 2)
    End With
End Sub
c'etait juste en passant ;)
 

patricktoulon

XLDnaute Barbatruc
re
ben c'est simple par exemple on teste la cellule A1
sub test()
msgbox [a1].font.underline
end sub
regarde le message
apres tu peut aller carrément dans les definitions pour savoir qui est membre de qui
1636376411494.png
 
re,
pourquoi boucler sur toutes les cellules
parce que, dans l'énoncé du post 1, il n'est pas précisé que toutes les cellules sélectionnées ont le même formatage de départ, je pars donc du principe qu'il peut y avoir certaines cellules en souligné et d'autres pas. C'est d'ailleurs comme cela que l'ébauche de code de ce post essaye de fonctionner.

Cordialement, @+
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof