Discussion :

[ESVBA]

Bonsoir,

mon code place une image différente dans la cellule "A1" en fonction du mode protégé ou non de la feuille.
J'utilise l'évènement "SheetActivate" qui me parait le mieux car je ne sais capturer le changement dans le ruban.

En mode non protégée, cela fonctionne bien.
Hélas en mode non protégé, j'obtiens ceci après plusieurs activation de la feuille protégée :


L'image du non protégée (en rouge) n'est pas effacée lors de l'activation de la protection mais en plus l'image "protégée" (en noire) se recopie avec un décalage à chaque fois que j'active la feuille.

Voici mon code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    On Error Resume Next
 
    'Ne pas détruire les images utilisées en allant sur cet onglet
    If ActiveSheet.Name = "Dessin" Then Exit Sub
 
    'Choisi pour le classeur l'emplacement du pictogramme
    Dim EmplacementCadenas As String
    EmplacementCadenas = "A1"
 
    'Archive emplacement du curseur
    Dim ac As Range
    Set ac = ActiveCell
 
    'Efface les pictogrammes existants : si n'existe pas, il y a RESUME NEXT
    ActiveSheet.Shapes("CadenasOpen").Delete
    ActiveSheet.Shapes("CadenasClose").Delete
 
    'Traitement affichage de la bonne icone
    If ActiveSheet.ProtectContents = True Then
        'Feuille protégée - Copie l'icone adéquate
        Sheets("Dessin").Shapes("CadenasClose").Copy
 
        'Déprotége pour modification
        ActiveSheet.Unprotect
 
        'Copie l'icône en 2 lignes
        ActiveSheet.Range("A1").Select
        DoEvents
        ActiveSheet.Paste
 
        'cadrage dans la cellule
        With ActiveSheet.Shapes("CadenasClose")
            .Top = Range(EmplacementCadenas).Top + (Range(EmplacementCadenas).Height - .Height) / 2
            .Left = Range(EmplacementCadenas).Left + (Range(EmplacementCadenas).Width - .Width) / 2
        End With
 
        'Reprotége la feuille
        ActiveSheet.Protect
    Else
        'Feuille Non Protégée - Copie l'icone adéquate
        Sheets("Dessin").Shapes("CadenasOpen").Copy
 
        'Copie l'icône en 2 lignes
        Range("A1").Select
        ActiveSheet.Paste
 
        'Cadrage dans la cellule
        With ActiveSheet.Shapes("CadenasOpen")
            .Top = Range(EmplacementCadenas).Top + (Range(EmplacementCadenas).Height - .Height) / 2
            .Left = Range(EmplacementCadenas).Left + (Range(EmplacementCadenas).Width - .Width) / 2
        End With
    End If
 
    '--- Se replace dans la cellule avant la procédure
    ac.Select
    Set ac = Nothing
 
    '---
    On Error GoTo 0
End Sub

Quel est le problème ?
J'ai même mis un "Doevents" entre la déprotection et la re-protection de la feuille.

Merci.

ESVBA

[ESVBA]

Personne n'a de solution ?
Ou ça n'intéresse personne ?

Je n'en vois toujours pas la solution.

ESVBA

[Marc-L]

Bonsoir,

commencer par mettre en commentaire la ligne On Error Resume Next étant vraiment une mauvaise idée
afin de trouver la source d'un problème !

_________________________________________________________________________________________________________

Je suis Paris, Charlie, Bruxelles, …

[ESVBA]

merci de t'intéresser à mon cas.

c'est une mauvaise idée car shapes().delete vont bugger. Je supprime les deux images même s'il y en a une de présente ou pas sur la feuille. C'est une manière d'initialiser la feuille.

J'ai aussi mis les shapes().delete en remarque

Ca n'efface rien (ok) et j'ai le même phénomène de décalage de l'image feuille verouillée ou non.

ESVBA

[ESVBA]

Si j'active plusieurs fois la feuille, les icones se mettent en 1 puis en 2 puis en 3 et si j'efface l'icone 2 la 4e prend sa place.



ESVBA

[jurassic pork]

hello,
voici ce que je te propose :
au lieu de n'effacer que l'image qui est sensée être présente sur ta feuille , tu effaces toutes les images dont le nom contient cadenas. Comme cela tu n'as pas besoin de gérer les exceptions sur l'effacement. D'autre part j'ai remarqué que quand la feuille est protégée , on a du mal à effacer les images donc il faut déprotéger temporairement la feuille. Pour éviter aussi des effets de scintillement, il serait judicieux d'utiliser le ScreenUpdating à false pendant la routine. Voici ce que cela donne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
 'On Error Resume Next
    'Ne pas détruire les images utilisées en allant sur cet onglet
    If ActiveSheet.Name = "Dessin" Then Exit Sub
    Application.ScreenUpdating = False
    'Choisi pour le classeur l'emplacement du pictogramme
    Dim EmplacementCadenas As String
    EmplacementCadenas = "A1"
 
    'Archive emplacement du curseur
    Dim ac As Range
    Set ac = ActiveCell
 
    'Traitement affichage de la bonne icone
    If ActiveSheet.ProtectContents = True Then
        'Feuille protégée - Copie l'icone adéquate
        Sheets("Dessin").Shapes("CadenasClose").Copy
 
        'Déprotége pour modification
        ActiveSheet.Unprotect
       ' On supprime toutes les images de Cadenas avant le coller
        SupprimerCadenas
        'Copie l'icône en 2 lignes
        ActiveSheet.Range("A1").Select
        'DoEvents
        ActiveSheet.Paste
 
        'cadrage dans la cellule
        With ActiveSheet.Shapes("CadenasClose")
            .Top = Range(EmplacementCadenas).Top + (Range(EmplacementCadenas).Height - .Height) / 2
            .Left = Range(EmplacementCadenas).Left + (Range(EmplacementCadenas).Width - .Width) / 2
        End With
 
        'Reprotége la feuille
        ActiveSheet.Protect
    Else
        'Feuille Non Protégée - Copie l'icone adéquate
        Sheets("Dessin").Shapes("CadenasOpen").Copy
        ' On supprime toutes les images de Cadenas avant le coller
        SupprimerCadenas
        'Copie l'icône en 2 lignes
        Range("A1").Select
        ActiveSheet.Paste
 
        'Cadrage dans la cellule
        With ActiveSheet.Shapes("CadenasOpen")
            .Top = Range(EmplacementCadenas).Top + (Range(EmplacementCadenas).Height - .Height) / 2
            .Left = Range(EmplacementCadenas).Left + (Range(EmplacementCadenas).Width - .Width) / 2
        End With
    End If
 
    '--- Se replace dans la cellule avant la procédure
    ac.Select
    Set ac = Nothing
 Application.ScreenUpdating = True
    '---
  ' On Error GoTo 0

Avec la procédure SupprimerCadenas :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Sub SupprimerCadenas()
  'Efface les pictogrammes dont le nom commence par Cadenas
    Dim Shp As Shape
    For Each Shp In ActiveSheet.Shapes
    If Shp.Name Like "Cadenas*" Then Shp.Delete
    Next Shp
End Sub

Peut être une autre idée. Mettre en permanence les deux icônes dans les feuilles (manuellement) et jouer sur la visibilité de l'une ou l'autre icône.

Ami calmant, J.P

[ESVBA]

n'ayant mon fichier ici, j'en ai recréé un.

Ta solution fonctionne : suppression de l'image en fonction de l'existence de l'image. (like "cadenas*"

Ma suppression brutale de toutes les images avec un "ON ERROR GOTO" semble être le problème. Pourquoi ?

Si tu as la réponse.

Merci à toi Jurassic Pork.

ESVBA