Autres Centrer ou Annuler Centrer

un internaute

XLDnaute Impliqué
Bonjour le forum
Dans la macro ci-dessous lorsque le texte est trop long dans colonne B je fait Centre Texte Colonnes B - C pas de problème
Lorsqu'il est centré sur colonnes B - C le bouton devrait afficher Annuler Centrer Texte Colonnes B - C
mais n'affiche pas Annuler Centrer Texte Colonnes B - C
Il affiche Centrer Texte Colonnes B - C alors qu'il devrait afficher Annuler Centrer Texte Colonnes B - C
Idem pour F -G


PS: je ne peux pas fournir de fichier


VB:
Sub CentrerSurPlusieursColonnes()
Dim Ligne As Long, Colonne As Integer
Dim Ws As Worksheet
Dim Sh As Shape
Dim Nom As String
Dim ModeCentrage As Integer

    Application.ScreenUpdating = False
'    ActiveSheet.Unprotect
  Ligne = Selection.Row
  Colonne = Selection.Column
 
  Set Sh = ActiveSheet.Shapes(Application.Caller)
  If Sh.TopLeftCell.Address = "$I$2" Then
    If Ligne < 6 Or Ligne > 36 Or Colonne < 6 Or Colonne > 7 Then
      MsgBox ("Centrer ou Annulation Centrer Hors Zone : F6:G36")
      Exit Sub
    End If
    With Sh.TextFrame
    'On compare les 7 caractères de gauche(Left)en Majuscule(UCase)du Texte du bouton avec les caractères en Majuscule(UCase)du mot "Centrer".
      If UCase(Left(.Characters.Text, 7)) = UCase("Centrer") Then
        .Characters.Text = "Annuler Centrer Texte" & vbLf & "Colonnes F - G"
        .Characters(Start:=1, Length:=15).Font.ColorIndex = 3
        .Characters(Start:=16, Length:=16).Font.ColorIndex = 5
        .Characters(Start:=32, Length:=5).Font.ColorIndex = 3
        ModeCentrage = xlCenterAcrossSelection
        Range("G" & Ligne) = Range("F" & Ligne)
      Else
        .Characters.Text = "Centrer Texte" & vbLf & "Colonnes F - G"
        .Characters(Start:=1, Length:=7).Font.ColorIndex = 3
        .Characters(Start:=8, Length:=16).Font.ColorIndex = 5
        .Characters(Start:=24, Length:=5).Font.ColorIndex = 3
        ModeCentrage = xlCenter
        Range("G" & Ligne) = ""
      End If
    End With
    With Range("F" & Ligne & ":G" & Ligne)
       .HorizontalAlignment = ModeCentrage
       .VerticalAlignment = xlCenter
    End With
  Else
    If Ligne < 6 Or Ligne > 36 Or Colonne < 2 Or Colonne > 3 Then
      MsgBox ("Centrer ou Annulation Centrer Hors Zone : B6:C36")
      Exit Sub
    End If
 
    If Range("B" & Ligne) = "" Or Ligne > Range("A" & Rows.Count).End(xlUp).Row Or Ligne < 5 Then
      Ligne = Range("A" & Rows.Count).End(xlUp).Row
    End If
      With Sh.TextFrame
      'On compare les 7 caractères de gauche(Left)en Majuscule(UCase)du Texte du bouton avec les caractères en Majuscule(UCase)du mot "Centrer".
        If UCase(Left(.Characters.Text, 7)) = UCase("Centrer") Then
        .Characters.Text = "Annuler Centrer Texte" & vbLf & "Colonnes B - C"
        .Characters(Start:=1, Length:=15).Font.ColorIndex = 3
        .Characters(Start:=16, Length:=16).Font.ColorIndex = 5
        .Characters(Start:=32, Length:=5).Font.ColorIndex = 3
          ModeCentrage = xlCenterAcrossSelection
        Else
        .Characters.Text = "Centrer Texte" & vbLf & "Colonnes B - C"
        .Characters(Start:=1, Length:=7).Font.ColorIndex = 3
        .Characters(Start:=8, Length:=16).Font.ColorIndex = 5
        .Characters(Start:=24, Length:=5).Font.ColorIndex = 3
        ModeCentrage = xlCenter
          ModeCentrage = xlCenter
 
        End If
      End With
 
        'Calcul de la dernière ligne.Celle-ci sera automatiquement centrée sur les colonnes B & C en cliquant sur le Bouton Centrer Texte Sur Plusieurs Colonnes
 
      With Range("B" & Ligne & ":C" & Ligne)
         .HorizontalAlignment = ModeCentrage
         .VerticalAlignment = xlCenter
      End With
    End If
'    ActiveSheet.Protect
End Sub
1707739813479.png


1707739842117.png
 
Dernière édition:

fanch55

XLDnaute Barbatruc
Salut,
D'après l'analyse succincte du code :
Si la cellule sélectionnée fait partie des plages B6-C36 ou F6-G36, on centre la cellule sélectionnée si elle ne l'est pas ou on annule tout alignement si elle est centrée ...
Comme aucunes cellules ne sont fusionnées, la sub devrait plutôt s'appeler CentrerCellule ...

Ai-je bon ? 🤔
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
Bonjour
juste en passant
là encore une fois même si dans la demande il est précisé qu'il y a impossibilité de fournir un fichier
il aurait été bien utile surtout qu'en deux coup de cuillère a pot le demandeur aurai pu faire un fichier exemple

pourquoi il aurait été utile:
et bien tout simplement par ce je ne suis pas sur que la condition ci dessous soit celle que tu souhaite
VB:
 If Ligne < 6 Or Ligne > 36 Or Colonne < 6 Or Colonne > 7 Then

en effet les deux 2d (en l’occurrence pour les colonnes) vont à l'encontre des deux premières
que va t il se passer selon toi si nous somme sur la ligne 8 par exemple et la colonne 4

les additions logiques(and /or / xor) ça peut être un vrai casse tête quand on maitrise pas
surtout dans le cadre d'abssice et ordonnée

à méditer
tiens allez teste ça

Code:
Sub test()
   Dim Ligne& , Colonne&
 Ligne = 8
    Colonne = 4
    If Ligne < 6 Or Ligne > 36 Or Colonne < 6 Or Colonne > 7 Then
        MsgBox "Et!!...OUAIP!!!! on passe c'est baloh!!! hein !!!"
    End If
End Sub
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
allez après je laisse la main à @fanch55
la condition que tu souhaite c'est
si ligne <6 ou >36 ET!!!! colonne<6 ou colonne >7
pour faire celà tu ne peut pas l'ecrire comme ca
Code:
If Ligne < 6 Or Ligne > 36 and Colonne < 6 Or Colonne > 7 Then
car là encore le and (pour colonne) va contredire la condition ligne
on l'ecrira plutot comme ça
Code:
If (Ligne < 6 Or Ligne > 36) and (Colonne < 6 Or Colonne > 7Then)
là oui je te garantie que ca fera le job
test d'exemple
change les valeur de ligne et colonne
VB:
Sub test()
    Ligne = 4
    Colonne = 6
    If (Ligne < 6 Or Ligne > 36) And (Colonne < 6 Or Colonne > 7) Then
        MsgBox "Et Bien sur que là on passe "
    Else
    MsgBox "mais bien sur!!! que non que l'on passe pas!!! "
    End If

End Sub
bonne continuation ;)
 

un internaute

XLDnaute Impliqué
Bonsoir fanch55
Pour être plus explicite
Je tape du texte dans n'importe quelle cellule par exemple B6
Le texte est trop long je suis obligé de cliquer sur

1707752611630.png


Il est centré sur les 2 colonnes
J'enregistre
Si le texte contient colonne B je ne fait rien
Ensuite si je reviens par exemple sur B6 ça n'affiche pas
1707752523442.png

Ça affiche

1707752557351.png


Si je viens sur cellule B7 par exemple et que le texte contient dans colonne B
Ça ne met pas ou des fois oui mais pas systématique

1707752856968.png

mais

1707752924242.png
 

un internaute

XLDnaute Impliqué
Bonjour le forum
Avec toutes mes excuses pour le retard
Mais vous ne pouviez pas arriver à faire ce que je voulais sans fichier et de plus j'ai changé de stratégie

Voici la macro

VB:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim Obj As Shape, Ligne As Long
Dim ColRef As String
Dim ColDep As String, ColsUtiles As String
                                                      ' Change automatiquement le texte du bouton
  Ligne = Selection.Row
 
    If UCase(Sh.Name) = "MENU" And Target.Count > 1 Then Exit Sub
    
    Application.ScreenUpdating = False
    If Target.Column = 2 Then
      ColRef = "A1"
      ColDep = "B"
      ColsUtiles = "Colonnes B - C"
    ElseIf Target.Column = 6 Then
      ColRef = "I2"
      ColDep = "F"
      ColsUtiles = "Colonnes F - G"
    Else
      Exit Sub
    End If
      
'      ActiveSheet.Unprotect

    For Each Obj In ActiveSheet.Shapes
      If InStr(1, Obj.TextFrame.Characters.Text, "Centrer Texte", vbTextCompare) > 0 And Obj.TopLeftCell.Address(0, 0) = ColRef Then Exit For
    Next Obj

    If Not Obj Is Nothing Then
    ' Calcul de la dernière ligne.Celle-ci sera automatiquement centrée sur les colonnes B & C en cliquant sur le Bouton Centrer Texte Sur Plusieurs Colonnes

      With Obj.TextFrame
        If Range(ColDep & Ligne).HorizontalAlignment = xlCenterAcrossSelection Then
          .Characters.Text = "Annuler Centrer Texte" & vbLf & ColsUtiles
        .Characters(Start:=1, Length:=15).Font.ColorIndex = 3
        .Characters(Start:=16, Length:=16).Font.ColorIndex = 5
        .Characters(Start:=32, Length:=5).Font.ColorIndex = 3
          '.Characters(Start:=23, Length:=22).Font.ColorIndex = 5
        Else
          .Characters.Text = "Centrer Texte" & vbLf & ColsUtiles
        .Characters(Start:=1, Length:=7).Font.ColorIndex = 3
        .Characters(Start:=8, Length:=16).Font.ColorIndex = 5
        .Characters(Start:=24, Length:=5).Font.ColorIndex = 3
          '.Characters(Start:=15, Length:=22).Font.ColorIndex = 5
        End If
      End With
    End If
End Sub

Je renouvelle encore mes excuses mais vos exemples je suis preneur
Cordialement
 

fanch55

XLDnaute Barbatruc
Mais vous ne pouviez pas arriver à faire ce que je voulais sans fichier et de plus j'ai changé de stratégie
La macro fournie ne centre ou ne décentre rien, elle semble incomplète .
Le code ci-dessous tente de se coller au plus près du code fourni et devrait pouvoir la remplacer.
Associez la Macro Align_Cell aux shapes concernés .
VB:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Dwo As Object, Shp As Object, Cible As String
    For Each Shp In Sh.DrawingObjects
        If Shp.TopLeftCell.Address = "$A$1" _
        Or Shp.TopLeftCell.Address = "$I$2" _
        Then Shp.Visible = False
    Next
    Select Case True
    Case Target.Count > 1
    Case UCase(Sh.Name) = "MENU"
    Case Not Intersect(Target, Union([B:C], [F:G])) Is Nothing
        For Each Shp In Sh.DrawingObjects
            Select Case True
            Case Shp.TopLeftCell.Address = "$A$1" _
             And Not Intersect(Target, [B:C]) Is Nothing
                Set Dwo = Shp
                Cible = vbLf & "Colonnes B-C"
                Exit For
            Case Shp.TopLeftCell.Address = "$I$2" _
             And Not Intersect(Target, [F:G]) Is Nothing
                Set Dwo = Shp
                Cible = vbLf & "Colonnes F-G"
                Exit For
            End Select
        Next
        If Not Dwo Is Nothing Then
            With Dwo
                .Visible = True
                .Font.ColorIndex = 5
                .Text = IIf(Target.HorizontalAlignment = xlCenterAcrossSelection, _
                            "Annuler Centrer Texte", _
                            "Centrer Texte") & Cible
                .Characters(Start:=1, Length:=InStr(.Text, " Texte")).Font.ColorIndex = 3
                .Characters(Start:=InStr(.Text, "s") + 1).Font.ColorIndex = 3
            End With
        End If
    End Select
End Sub
Sub Align_Cell()
    Dim Target As Range
    With Selection
        Select Case .Column
            Case Columns("B").Column, Columns("F").Column:  Set Target = .Resize(, 2)
            Case Columns("C").Column, Columns("G").Column:  Set Target = .Offset(, -1).Resize(, 2)
        End Select
        With Target
            If .Cells(1) = "" Then .Cells(1) = .Cells(2): .Cells(2) = ""
            .HorizontalAlignment = IIf(.HorizontalAlignment = xlCenterAcrossSelection, xlCenter, xlCenterAcrossSelection)
            .VerticalAlignment = xlCenter
        End With
        Workbook_SheetSelectionChange ActiveSheet, .Cells(1)
    End With
    Application.EnableEvents = True
End Sub

Je vous signale toutefois que mettre le code dans le Thisworkbook implique que le code concerne toutes les feuilles ( sauf Menu ) ....
 

Discussions similaires

Réponses
22
Affichages
633
Réponses
4
Affichages
141

Statistiques des forums

Discussions
311 191
Messages
2 077 784
Membres
242 264
dernier inscrit
ANA-HOWA