Erreur macro mais où,

[un internaute]

Bonjour le forum,
Pourquoi ça bug dans macro ci-dessous: Ligne rouge


Sub CentrerTexte()
Dim Ligne As Long
Dim Ws As Worksheet
Dim Sh As Shape
Dim Nom As String
Dim ModeCentrage As Integer

Application.ScreenUpdating = False
Set Sh = ActiveSheet.Shapes(Application.Caller)
If UCase(Left(Sh.Characters.Text, 6)) = UCase("Aucune") Then Exit Sub
ActiveSheet.Unprotect
With Sh.TextFrame

If UCase(Left(.Characters.Text, 7)) = UCase("centrer") Then
.Characters.Text = "Annuler Centrer Texte" & vbLf & "Sur Plusieurs Colonnes"
.Characters(Start:=23, Length:=22).Font.ColorIndex = 5
ModeCentrage = xlCenterAcrossSelection
Else
.Characters.Text = "Centrer Texte" & vbLf & "Sur Plusieurs Colonnes"
.Characters(Start:=15, Length:=22).Font.ColorIndex = 5
ModeCentrage = xlCenter
End If
End With
Ligne = Selection.Row
'Ligne = Range("H" & Rows.Count).End(xlUp).Row
With Range("H" & Ligne & ":I" & Ligne)
.HorizontalAlignment = ModeCentrage
.VerticalAlignment = xlCenter
End With
ActiveSheet.Protect
End Sub

Macro dans feuille

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Sh As Shape

If Target.Count = 1 Then
'If Not Intersect(Columns("H:I"), Target) Is Nothing And Target.Count = 1 Then
Set Sh = ActiveSheet.Shapes("Centrage")
ActiveSheet.Unprotect
With Sh.TextFrame
If (Range("H" & Target.Row) <> "" And Range("I" & Target.Row) <> "") Or _
(Range("H" & Target.Row) = "" And Range("I" & Target.Row) = "") Then
.Characters.Text = "Aucune Action Possible"
ElseIf Range("H" & Target.Row).HorizontalAlignment = xlCenterAcrossSelection Then
.Characters.Text = "Annuler Centrer Texte" & vbLf & "Sur Plusieurs Colonnes"
.Characters(Start:=23, Length:=22).Font.ColorIndex = 5
ElseIf (Range("H" & Target.Row) <> "" And Range("I" & Target.Row) = "") Or _
(Range("H" & Target.Row) = "" And Range("I" & Target.Row) <> "") Then
.Characters.Text = "Centrer Texte" & vbLf & "Sur Plusieurs Colonnes"
.Characters(Start:=15, Length:=22).Font.ColorIndex = 5
End If
End With
ActiveSheet.Protect
End If
End Sub


Merci pour vos retours
Cordialement

 

[un internaute]

Bonjour le forum,
J'ai mis la ligne en roure en commentaire et ça fonctionne.
Logique?
Cordialement

 

[Paf]

bonjour,

il manquerait bien .TextFrame dans la ligne rouge

If UCase(Left(Sh .TextFrame.Characters.Text, 6)) =...


Ou alors déplacer la ligne rouge, après avoir supprimer Sh, après la ligne With Sh.TextFrame

If UCase(Left(.Characters.Text, 6)) = ...

A+

 

[un internaute]

Bonjour Paf,
SUPER.
Je te remercie
Bon WE à toi
Bien cordialement