Exécution macro sous plusieurs conditions

Version imprimable

10/11/2018, 00h50
Oh so sick

Exécution macro sous plusieurs conditions

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..
10/11/2018, 04h58
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. :weird:
Montrez nous au moins la partie du code qui pose problème :?
Cordialement 8-)

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:

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 8-)

10/11/2018, 15h59
Oh so sick

1 pièce(s) jointe(s)

Merci bien pour ton aide Transitoire :ccool:

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 ;)
10/11/2018, 17h13
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. :weird:

Citation:

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?:calim2:
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 8-)
10/11/2018, 17h51
Oh so sick

De quel module s’agit-il ?

Voici le code contenue dans le module 1

Code:

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

10/11/2018, 18h44
Oh so sick

Citation:

Envoyé par 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. :weird:

J'avoue ne pas bien comprendre la phrase ci-dessus?:calim2:
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 8-)

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.
15/11/2018, 20h32
Oh so sick

Bonsoir !

Tu aurais une suggestion Transitoire ? :)

Bonsoir,

J'ai une piste concernant la recopie d'un autre feuillet sur "Pointage"
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Private Sub Worksheet_Change(ByVal Target As Range) Dim cell As Object For Each cell In Range("L3") If cell = "" Then cell = "Veuillez entrer le numéro de semaine à saisir." Else Worksheets("Pointage").Range("D13:R32").Value = Worksheets("S" & Workbooks("Feuille de pointage.xlsm").Worksheets("Pointage").Range("M8").Value & " - " & Workbooks("Feuille de pointage.xlsm").Worksheets("Pointage").Range("J8")).Range("D13:R32").Value End If Next cell End Sub
Si la feuille existe (que je ne saisit pas une nouvelle semaine) alors les cellule se transfère bien cependant si la feuille n'est pas présente dans le classeur j'ai une erreur (logique étant donnée que la feuille n'existe pas...). Faudrait t'il insérer une fonction "Existe" car j'en ai déjà une pour l'archivage des semaines.

Mais... comment l'intégrer à ma fonction change car j'utilise pour l'archivage "If Not Existe" alors je créé une nouvelle feuille sinon je la modifie.

Voici ma fonction Existe
Code:

1 2 3 4 5 6 7 8 9 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
Merci si un expert passe dans le coin..

Cordialement.

16/11/2018, 23h04
unparia

Bonjour
1) je n'accepte jamais d'ouvrir un classeur tiers et n'ai donc ps ouvert le tien
2) je n'accepte jamais non plus de traiter des difficultés distinctes dans une même discussion.
Je m'en tiens donc à la seule première demande :
Il est très simple et efficace de ne montrer (propriété visible) la checkbox et/ou un bouton de commande que si la cellule en cause contient une donnée numérique (utilisation de l'évènement worksheet_change).
Il est également très simple de décocher la checkbox (pour éviter qu'elle ne garde son ancienne éventuelle valeur) . Cela se fait dans l'évènement worksheet_selectionchange
Et de cette manière, ne se pose plus le moindre problème d'expression conditionnelle.

Et il est par ailleurs encore plus simple de se défaire totalement de cette checkbox et de la remplacer par une msgbox Yes/No à ne faire apparaître que si la saisie le justifie (à mettre dans l'évènement worksheet_change)
17/11/2018, 13h34
Oh so sick

Merci unparia de ton aide, j'ouvre donc une nouvelle discussion pour mon nouveau problème.