1. Accueil
  2. Forum Codes-Sources
  3. Visual Basic
  4. Visual Basic 6

Reprotection automatique SHAPE modifié [Résolu]

Signaler
Messages postés
377
Date d'inscription
lundi 3 avril 2006
Statut
Membre
Dernière intervention
22 août 2018
 -
Messages postés
377
Date d'inscription
lundi 3 avril 2006
Statut
Membre
Dernière intervention
22 août 2018
 -
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
Messages postés
377
Date d'inscription
lundi 3 avril 2006
Statut
Membre
Dernière intervention
22 août 2018
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
Réponse 2 / 3
Messages postés
377
Date d'inscription
lundi 3 avril 2006
Statut
Membre
Dernière intervention
22 août 2018
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
Réponse 3 / 3
Messages postés
377
Date d'inscription
lundi 3 avril 2006
Statut
Membre
Dernière intervention
22 août 2018
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
Répondre Posez votre question