Initialisation de menu déroulant et de boite à cocher

**Audrée F** · 25/10/2018, 16h22

Bonjour à tous,

Depuis quelques jours je fais face à une impasse. J'ai créé un document/formulaire lié à une base de donnée. J'ai programmé une Macro (bouton nouveau) pour qu'elle efface toutes les vieilles donnée et que celle-ci mettre à zéro toutes les boites à cocher et les menus déroulants. La première partie de mon codage VBA pour la première feuille de travail fonctionne bien. Lorsque je répète le même codage pour les deux autres feuilles IMPASSE ! j'ai des messages d'erreur... Je n'y comprend plus rien...

Vous trouverez mon projet en pièces jointe.

Merci d'avance

Invité · 26/10/2018, 04h52

Envoyé par Audrée F

Bonjour,

Votre onglet Paiement est protégé, je n'ai pas regardé quelles cellules étaient concernées par la protection dans celles à effacer. Il y a peut-être d'autres erreurs mais le code ci-dessous fonctionne, je n'ai pas fait de saisie sur toutes les cellules.
Nb : Vous devriez mettre en couleur les zones de saisie.

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
62
63
64
 
Sub Nouveau()
 
Dim Ctrl As Shape
Dim ShContact As Worksheet, ShCampeur As Worksheet, ShPaiement As Worksheet
 
    Set ShContact = Sheets("Contacts_Transport")
    Set ShCampeur = Sheets("Dossier_campeur")
    Set ShPaiement = Sheets("Paiement")
 
    With ShContact
 
         For Each Ctrl In .Shapes
             If Ctrl.Type = 8 Then Ctrl.ControlFormat.Value = 0
         Next
 
         With .Range("B5,F5,B6,H6,B7,H7,B10,F10,E11,B12,D12,F12,H12,B13,B16,F16,E17,B18,D18,F18")
              .ClearContents
              '.Interior.Color = RGB(255, 255, 0)
         End With
         With .Range("H18,B19,C22,E22,C23,F23,C24,E24,C25,C26,C27,F27,C28,E28,C29,C30,B33")
              .ClearContents
              '.Interior.Color = RGB(255, 255, 0)
         End With
         With .Range("F33,E34,B35,D35,F35,H35,C30,B33,F33,E34,B35,D35,F35,H35,B36,F36,E37,B38,D38,F38,H38,B44,F44,B45,F45,B47,F47,B48,F48,C58,G58")
              .ClearContents
              '.Interior.Color = RGB(255, 255, 0)
         End With
 
 
    End With
 
 
    With ShCampeur 'Sheets("Dossier_campeur").Select
         With .Range("F16:F20,B21,H21,E24:H24,J24,E27:H27,J27,B30,D30,I30:J30,G33,G34,G35,F36,I36,C37")
              .ClearContents
             ' .Interior.Color = RGB(255, 255, 0)
         End With
         With .Range("C37:C43,C47:J47,G57,G59,F64,F69,F71,B75,F83,A85:J85,F88,F89,F100:F108,D111:D122,A131:J131")
              .ClearContents
              '.Interior.Color = RGB(255, 255, 0)
         End With
     End With
 
 
    With ShPaiement 'Sheets("Paiement").Select
         .Unprotect
         With .Range("B3,K3,B4,G4,G5,B6,H6,B7,K7,B8:C8,E8:F8,H8:I8,K8,B9,E10:K10,B13,K13,B14,G14,G15,B16,H16,B17,K17,B18:C18,E18:F18,H18:I18,K18,B19,B45")
              .ClearContents
             ' .Interior.Color = RGB(255, 255, 0)
         End With
         .Protect
    End With
 
    ActiveWorkbook.SaveAs Filename:= _
        "\\garagonaserver\Campeurs\FICHIERS CAMPEUR\AAA_DOSSIER_PERMANENT_MASTER_FORM_INSCRIPTION.xlsm" _
        , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
 
 
    Set ShContact = Nothing
    Set ShCampeur = Nothing
    Set ShPaiement = Nothing
 
End Sub

**patricktoulon** · 26/10/2018, 08h33

re
Bonjour
pourquoi ne pas nommer ces plages non contigues et faire un range("nomde la plage").clearcontents

**Audrée F** · 29/10/2018, 16h48

Bonjour Éric,

Merci pour ta précieuse aide. MAIS ! J'éprouve des difficultés que j'essaie de résoudre selon mes connaissances et elles se limites là <- (lol). Quand je test la macro les cases à cocher et menus déroulants de la première feuille (Contact_transport) s'efface. Excepter les deux autres (Dossier_Campeur & Paiement).

Note: J'avais aussi à protéger toutes les feuilles sauf celles des suivis (téléphonique et infirmerie).

Peux-tu m'aider à nouveau ?

Merci d'avance

Invité · 29/10/2018, 18h05

Envoyé par Audrée F

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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
 
 Sub Nouveau()
 
Dim Ctrl As Shape
Dim ShContact As Worksheet, ShCampeur As Worksheet, ShPaiement As Worksheet
 
    Set ShContact = Sheets("Contacts_Transport")
    Set ShCampeur = Sheets("Dossier_campeur")
    Set ShPaiement = Sheets("Paiement")
 
    With ShContact
         .Unprotect
         For Each Ctrl In .Shapes
             If Ctrl.Type = 8 Then Ctrl.ControlFormat.Value = 0
         Next
 
         With .Range("B5,F5,B6,H6,B7,H7,B10,F10,E11,B12,D12,F12,H12,B13,B16,F16,E17,B18,D18,F18")
              .ClearContents
              .Interior.Color = RGB(255, 255, 0)
         End With
         With .Range("H18,B19,C22,E22,C23,F23,C24,E24,C25,C26,C27,F27,C28,E28,C29,C30,B33")
              .ClearContents
              .Interior.Color = RGB(255, 255, 0)
         End With
         With .Range("F33,E34,B35,D35,F35,H35,C30,B33,F33,E34,B35,D35,F35,H35,B36,F36,E37,B38,D38,F38,H38,B44,F44,B45,F45,B47,F47,B48,F48,C58,G58")
              .ClearContents
              .Interior.Color = RGB(255, 255, 0)
         End With
         .Protect
    End With
 
    With ShCampeur 'Sheets("Dossier_campeur").Select
         .Unprotect
         For Each Ctrl In .Shapes
 
             If Ctrl.Type = 8 Then
 
                If Mid(Ctrl.Name, 1, Len("Group Box")) = "Group Box" Then
                        ' Debug.Print Ctrl.Name
                End If
 
                If Mid(Ctrl.Name, 1, Len("Check Box")) = "Check Box" Then
                   Ctrl.ControlFormat.Value = 0
 
                End If
                If Mid(Ctrl.Name, 1, Len("Drop Down")) = "Drop Down" Then
                   Ctrl.ControlFormat.Value = 0
 
                End If
             End If
         Next
 
         With .Range("F16:F20,B21,H21,E24:H24,J24,E27:H27,J27,B30,D30,I30:J30,G33,G34,G35,F36,I36,C37")
              .ClearContents
              .Interior.Color = RGB(255, 255, 0)
         End With
         With .Range("C37:C43,C47:J47,G57,G59,F64,F69,F71,B75,F83,A85:J85,F88,F89,F100:F108,D111:D122,A131:J131")
              .ClearContents
              .Interior.Color = RGB(255, 255, 0)
         End With
        .Protect
     End With
 
 
    With ShPaiement 'Sheets("Paiement").Select
         .Unprotect
         For Each Ctrl In .Shapes
             If Ctrl.Type = 8 Then Ctrl.ControlFormat.Value = 0
         Next
         With .Range("B3,K3,B4,G4,G5,B6,H6,B7,K7,B8:C8,E8:F8,H8:I8,K8,B9,E10:K10,B13,K13,B14,G14,G15,B16,H16,B17,K17,B18:C18,E18:F18,H18:I18,K18,B19,B45")
              .ClearContents
              .Interior.Color = RGB(255, 255, 0)
         End With
         .Protect
    End With
 
    ActiveWorkbook.SaveAs Filename:= _
        "\\garagonaserver\Campeurs\FICHIERS CAMPEUR\AAA_DOSSIER_PERMANENT_MASTER_FORM_INSCRIPTION.xlsm" _
       , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
 
 
    Set ShContact = Nothing
    Set ShCampeur = Nothing
    Set ShPaiement = Nothing
 
End Sub

**Audrée F** · 29/10/2018, 20h31

Je veux te remercier Éric. Toute seule je n'aurais jamais trouvé la solution.

Initialisation de menu déroulant et de boite à cocher [XL-2016]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager