J'ai un shape (rectangle) dans une feuille protégée (DrawingObjects:= False),
qui contient d'autres shapes (graphiques).
En cliquant dessus, je souhaite ne déprotéger QUE le shape, modifier sa largeur et le reprotéger automatiquement en lâchant sa poignée de modification.
A force dde tourner en rond, j'ai trouvé une porte de sortie "acceptable"...
Dans un module :
Public MemWidth As Etat
'Merci à S.Nikator
Type Etat
WidthIni As Variant
WidthFin As Variant
End Type
'°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°
Sub ZoneRouge()
'Associée à Rectangle 468
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True
ActiveSheet.Shapes("Rectangle 468").Select
WidthIni = ActiveSheet.Shapes("Rectangle 468").Width
End Sub
Dans la feuille où est Shape(rectangle) :
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'réactive la protection des graphiques si ZoneRouge a été modifiée
Application.ScreenUpdating = False
WidthFin = ActiveSheet.Shapes("Rectangle 468").Width
If WidthFin <> MemWidth.WidthIni Then
MemWidth.WidthIni = WidthFin
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
End Sub
Mais....
1°) Cela ne résoud pas la SEULE déprotection du Shape (rectangle)
2°) SelectionChange pour "extraire" l'évènement click gauche, c'est quand même pas terrible!
J'espère que l'un d'entre-vous trouvera mieux que moi.
Dans le § "pour info", j'ai oublié de joindre le code de reprotection de la feuille (et donc des shapes) pour toute sélection dans la feuille :
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If (Target.Row ActiveCell.Row And Target.Column ActiveCell.Column) _
Or (Target.Row <> ActiveCell.Row And Target.Column <> ActiveCell.Column) _
Then ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Row = ActiveCell.Row _
Or Target.Column = ActiveCell.Column _
Or Target.Row <> ActiveCell.Row _
Or Target.Column <> ActiveCell.Column _
Then ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
Et puis, bien sûr, la macro :
Sub WidthNew()
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True
ActiveSheet.Shapes("Rectangle 468").Select
WidthIni = ActiveSheet.Shapes("Rectangle 468").Width
End Sub