Sujet Précédent Sujet Suivant

Reprotection automatique SHAPE modifié

Résolu
CerberusPau Messages postés 377 Date d'inscription lundi 3 avril 2006 Statut Membre Dernière intervention 22 août 2018 - 1 nov. 2010 à 17:45
CerberusPau Messages postés 377 Date d'inscription lundi 3 avril 2006 Statut Membre Dernière intervention 22 août 2018 - 2 nov. 2010 à 01:31
Bonjour à tous,

Une "petite" question :

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.

Le code :
ActiveSheet.Shapes("Rectangle 468").Unprotect

ne fonctionne (évidemment!) pas.

En revanche, avec :
ActiveSheet.Protect DrawingObjects: =False, Contents:=True, Scenarios:=True
ActiveSheet.Shapes("Rectangle 468").Select

Le shape (rectangle) est bien déprotégé et sélectionné... mais les autres shapes sont eux-aussi déverrouillés!...

Enfin, j'ai bien trouvé comment "récupérer" la valeur initiale de la largeur :
WidthIni = ActiveSheet.Shapes("Rectangle 468").Width

Mais comment la comparer à la valeur finale quand j'aurai lâché la poignée, et reprotéger automatiquement le shape (rectangle)?

Pour info, toute autre sélection dans la feuille reprotège les shapes.

Merci beaucoup pour votre aide indéfectible.

Cordialement.
Rataxes64

3 réponses

Réponse 1 / 3
CerberusPau Messages postés 377 Date d'inscription lundi 3 avril 2006 Statut Membre Dernière intervention 22 août 2018 1
2 nov. 2010 à 01:31
Bonsoir,

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.

Cordialement
Rataxes64
3
Réponse 2 / 3
CerberusPau Messages postés 377 Date d'inscription lundi 3 avril 2006 Statut Membre Dernière intervention 22 août 2018 1
1 nov. 2010 à 18:37
Re bonjour,

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

Cordialement
Rataxes64
0
Réponse 3 / 3
CerberusPau Messages postés 377 Date d'inscription lundi 3 avril 2006 Statut Membre Dernière intervention 22 août 2018 1
1 nov. 2010 à 19:02
Oups!

Erreur de copier-coller : 

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

est affectée au shape (rectangle)

Cordialement
Rataxes64
0
Rejoignez-nous