Discussion :

[Oh so sick]

Bonsoir,

je viens vous demander votre aide sur un petit problème ou je me casse la tête depuis plusieurs heures déjà !

J'ai besoin de lancer une macro via un bouton sous plusieurs condition. Pour vous faire simple, j'ai une checkbox et une cellule qui contient une phrase si la cellule est vide codé en VBA. Cette cellule sert a entrer un donnée numérique pour modifier l'ensemble du document et la checkbox à faire confirmer par l'utilisateur que les information saisit sont correcte.

Ainsi si la cellule n'est pas renseignée par un chiffre l'utilisateur va créer par une macro générale associée a la macro du bouton un nouveau document archive et au contraire si elle est renseignée il va modifier une archive déjà existante.

Il faudrait donc que si la checkbox n'est pas validée lors de l'exécution de la macro du bouton avoir un msgbox "veuillez confirmer l'exactitude des information saisit" peut importe si il modifie ou crée un nouveau document archive (donc si la cellule de modification contient ou non un chiffre).
Si la cellule de modification n'est pas renseignée et la checkbox validée lancer la macro générale.
Et enfin si la cellule de modification est renseignée (obligatoirement avec un chiffre) et la checkbox valider avoir un vbyesno qui confirme ou non la modification du document archive déjà enregistrer.

Voila, j'ai réussi à coder l'ensemble de mon document mais là je vous avoue que j'ai besoin d'experts... J'essaye depuis plusieurs heure avec les IF checkbox xlon AND Cell.value<>"" etc etc mais rien n'y fait ca devient beaucoup trop compliqué pour moi...

Si vous pouviez m'aider à m'indiquer la règle générale qu'il faut utiliser et j'y intégrerai la vérification de la checkbox ou de la cellule.

Merci de votre aide les experts, si vous avez besoin d'information n'hésiter pas et je ne peut pas poster le document car il contient déjà des informations concernant l'entreprise... j'espère que vous comprendrez..

[Transitoire]

Bonjour,
Vous demandez de l'aide, avec des explications peu compréhensibles!
Vous parlez d'un code que vous avez tenté de faire sans succès, sans nous le montrer!
Etes vous conscient que ça va être compliqué de vous aider.
Montrez nous au moins la partie du code qui pose problème
Cordialement

[Transitoire]

Re bonjour, si vous ne savez pas faire des "If" avec des "And" ensemble, séparez les If . Vous aurez le temps quand vous maitriserez mieux de rassembler les codes. Exemple:

Code :

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

1
2
3
4
5
6
7
8
9
10
If CheckBox1.Value = False Then  'Remplacer Checkbox1 par le vrai nom du CBox.
        MsgBox "veuillez confirmer l'exactitude des informations saisit!"
        End
Else
                If Range("A10").Value = "" Then 'à remplacer par la cellule considérée.
                        MacroGénérale 'Code si = "" , remplacer par le nom de la macro à effectuer
                Else
                    'code si valeur différente de "".
                End If
End If

Cordialement

[Oh so sick]

Merci bien pour ton aide Transitoire

Du coup j'ai procédé différemment pour intégrer mon idée !

J'aurai besoin de tes lumières une dernière fois afin de boucler le code.

J'aimerais que quand je modifie une feuille de pointage (si elle est déjà présente dans le classeur bien sur) avec la cellule L3 afficher les informations (seulement la plage D13:R32) dans l'onglet Pointage pour pouvoir les modifier et enregistrer à nouveau le document avec la macro.
As-tu une idée de comment procéder ?

Je te joins mon fichier Excel dépouillé des informations de l'entreprise, il faudra cependant que tu crées un autre fichier Excel en xlsx (Feuille de pointage commun), je te laisse voir le code !

Merci de ton aide c'est bien cool

[Transitoire]

Re, Désolé, mais j'ai téléchargé votre dossier, et je l'ai ouvert avec macros désactivées, par précaution. J'ai voulu inspecter vos macros pour m'assurer d'un minimum de sécurité et je me suis rendu compte qu'il y a un module dans lequel il est impossible de lire les procédures. Je refuse donc d'activer les macros.

J'aimerais que quand je modifie une feuille de pointage (si elle est déjà présente dans le classeur bien sur) avec la cellule L3 afficher les informations (seulement la plage D13:R32) dans l'onglet Pointage pour pouvoir les modifier et enregistrer à nouveau le document avec la macro.

J'avoue ne pas bien comprendre la phrase ci-dessus?
Y a t-il plusieurs feuilles de comptage, une par semaine et une feuille de comptage globale sur laquelle vous chargez provisoirement les données d'une semaine (si existante?). et que vous remettrez dans la feuille initiale après modifications???
Il est important que vous apportiez plus de précisions.
Cordialement

[Oh so sick]

De quel module s’agit-il ?

[Oh so sick]

Re, Désolé, mais j'ai téléchargé votre dossier, et je l'ai ouvert avec macros désactivées, par précaution. J'ai voulu inspecter vos macros pour m'assurer d'un minimum de sécurité et je me suis rendu compte qu'il y a un module dans lequel il est impossible de lire les procédures. Je refuse donc d'activer les macros.

J'avoue ne pas bien comprendre la phrase ci-dessus?
Y a t-il plusieurs feuilles de comptage, une par semaine et une feuille de comptage globale sur laquelle vous chargez provisoirement les données d'une semaine (si existante?). et que vous remettrez dans la feuille initiale après modifications???
Il est important que vous apportiez plus de précisions.
Cordialement

Il y a une feuille principale "Pointage" ou l'on rentre nos informations et lorsque j'exécute la macro la feuille s'enregistre dans un nouvelle onglet mais également dans un autre classeur Excel disponible sur le commun.

[Oh so sick]

Voici le code contenue dans le module 1

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
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
Sub Macro()
    Enregistrefeuille
   Application.ScreenUpdating = False
   If Worksheets("Pointage").Shapes("imprimer").ControlFormat.Value = xlOn Then
   With Worksheets("S" & Workbooks("Feuille de pointage.xlsm").Worksheets("Pointage").Range("M8").Value & " - " & Workbooks("Feuille de pointage.xlsm").Worksheets("Pointage").Range("J8")).PageSetup
    .PrintArea = "$A$1:$R$40"
    .Orientation = xlLandscape
    .Zoom = False
    .FitToPagesTall = 1
    .FitToPagesWide = 1
    End With
    Worksheets("S" & Workbooks("Feuille de pointage.xlsm").Worksheets("Pointage").Range("M8").Value & " - " & Workbooks("Feuille de pointage.xlsm").Worksheets("Pointage").Range("J8")).PrintOut
   End If
   Application.ScreenUpdating = True
    Enregistrecommun
End Sub
Sub Enregistrecommun()
Dim Chemin As String, Fichier As String, Fact As String
Dim Wbk As Workbook
Dim Sh As Worksheet
Application.ScreenUpdating = False
Chemin = "/Users/?/Desktop/archive/"
Fichier = "Feuille de pointage commun.xlsx"
Fact = "S" & Workbooks("Feuille de pointage.xlsm").Worksheets("Pointage").Range("M8").Value & " - " & Workbooks("Feuille de pointage.xlsm").Worksheets("Pointage").Range("J8")
If Dir(Chemin & Fichier) = "" Then
    Set Wbk = Workbooks.Add(1)
    Set Sh = Wbk.Worksheets(1)
    Sh.Name = Fact
    Wbk.SaveAs Chemin & Fichier
Else
    Set Wbk = Workbooks.Open(Chemin & Fichier)
    If Not Existe(Wbk, Fact) Then
        Set Sh = Wbk.Worksheets.Add(before:=Wbk.Sheets(1))
        Sh.Name = Fact
        ThisWorkbook.Worksheets(Fact).Shapes("Image 1").Copy
        ActiveSheet.Range("D35").PasteSpecial
        ThisWorkbook.Worksheets(Fact).Range("A1:AK100").Copy
        Wbk.Worksheets(Fact).Range("A1").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
        Wbk.Worksheets(Fact).Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
        Wbk.Worksheets(Fact).Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        Wbk.Worksheets(Fact).Range("A1").Select
        ActiveWindow.Zoom = 75
        Workbooks("Feuille de pointage.xlsm").Worksheets("Pointage").Activate
              Worksheets("Pointage").Range("D13:R32").ClearContents
    Worksheets("Pointage").Range("L3:R3").ClearContents
    Sheets("Pointage").Shapes("Confirmation").DrawingObject.Value = 0
    Sheets("Pointage").Shapes("imprimer").DrawingObject.Value = 0
        Set Sh = Nothing
        Wbk.Close True
        Set Wbk = Nothing
    Else
    Set Sh = Wbk.Worksheets(Fact)
        ThisWorkbook.Worksheets(Fact).Range("A1:T40").Copy
        Wbk.Worksheets(Fact).Range("A1").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
        Wbk.Worksheets(Fact).Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
        Wbk.Worksheets(Fact).Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    ActiveSheet.Range("A1").Select
        Wbk.Worksheets(1).Activate
        Workbooks("Feuille de pointage.xlsm").Worksheets(Fact).Activate
        Worksheets(Fact).Range("A1").Select
        Worksheets("Pointage").Activate
              Worksheets("Pointage").Range("D13:R32").ClearContents
    Worksheets("Pointage").Range("L3:R3").ClearContents
    Sheets("Pointage").Shapes("Confirmation").DrawingObject.Value = 0
    Sheets("Pointage").Shapes("imprimer").DrawingObject.Value = 0
        Set Sh = Nothing
        Wbk.Close True
        Set Wbk = Nothing
    End If
End If
End Sub
Sub Enregistrefeuille()
Dim Chemin As String, Fichier As String, Fact As String
Dim Wbk As Workbook
Dim Sh As Worksheet
Application.ScreenUpdating = False
Chemin = "/Users/?/Desktop/"
Fichier = "Feuille de pointage.xlsm"
Fact = "S" & Workbooks("Feuille de pointage.xlsm").Worksheets("Pointage").Range("M8").Value & " - " & Workbooks("Feuille de pointage.xlsm").Worksheets("Pointage").Range("J8")
If Dir(Chemin & Fichier) = "" Then
    Set Wbk = Workbooks.Add(1)
    Set Sh = Wbk.Worksheets(1)
    Sh.Name = Fact
    Wbk.SaveAs Chemin & Fichier
Else
    Set Wbk = Workbooks.Open(Chemin & Fichier)
    If Not Existe(Wbk, Fact) Then
        Set Sh = Wbk.Worksheets.Add(after:=Wbk.Sheets(1))
        Sh.Name = Fact
        Workbooks("Feuille de pointage.xlsm").Worksheets("Pointage").Shapes("Image 2").Copy
        ActiveSheet.Range("D35").PasteSpecial
        Workbooks("Feuille de pointage.xlsm").Worksheets("Pointage").Range("A7:T40").Copy
        Wbk.Worksheets(Fact).Range("A7").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
        Wbk.Worksheets(Fact).Range("A7").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
        Wbk.Worksheets(Fact).Range("A7").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
        Workbooks("Feuille de pointage.xlsm").Worksheets("Pointage").Range("A1:G6").Copy
        Wbk.Worksheets(Fact).Range("A1").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
        Wbk.Worksheets(Fact).Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
        Wbk.Worksheets(Fact).Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        Range("A41:U100").Interior.ColorIndex = 2
    Range("U1:AK100").Interior.ColorIndex = 2
    Range("H1:T6").Interior.ColorIndex = 2
    ActiveWindow.Zoom = 75
        ActiveSheet.Range("A1").Select
        Set Sh = Nothing
        Wbk.Save
        Set Wbk = Nothing
        Worksheets("Pointage").Activate
    Else
    If MsgBox("Voulez-vous remplacer la feuille de pointage existante ?", vbYesNo, "Attention !") = vbYes Then
    Set Sh = Wbk.Worksheets(Fact)
        Workbooks("Feuille de pointage.xlsm").Worksheets("Pointage").Range("A8:T40").Copy
        Wbk.Worksheets(Fact).Range("A8").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
        Wbk.Worksheets(Fact).Range("A8").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
        Wbk.Worksheets(Fact).Range("A8").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        ActiveSheet.Range("A1").Select
        Set Sh = Nothing
        Wbk.Save
        Set Wbk = Nothing
    Worksheets("Pointage").Activate
        Else: End
        End If
    End If
End If
 
End Sub
Private Function Existe(ByVal Wbk As Workbook, ByVal Str As String) As Boolean
Dim Sh As Worksheet
For Each Sh In Wbk.Sheets
    If UCase(Sh.Name) = UCase(Str) Then
        Existe = True
        Exit For
    End If
Next Sh
End Function
Sub Bouton()
Application.ScreenUpdating = False
   If Sheets("Pointage").Shapes("Confirmation").ControlFormat.Value = xlOn Then
 
   Call Macro
    Else
MsgBox "Veuillez vérifier l'exactitude des informations saisit", vbOKOnly + vbInformation, "Attention !"
   End If
   Application.ScreenUpdating = True
End Sub