VBA- Ajout Message BOX

**gouN40** · 14/04/2021, 16h50

Bonjour à tous,

Je viens vers vous afin de vous demander un petit service.

J'ai actuellement un fichier Excel pour mon boulot qui gères nos salariés.
Sur un onglet, qui sert à compléter une "Fiche de nouveaux Salariés", j'ai un bouton qui permet d'ajouter le nouveau salarié à une BDD sur un onglet caché et protégé en écriture.
Jusqu'ici tout va très bien et tout fonctionne.

Maintenant la personne qui gère ce fichier souhaiterai qu'en cliquant sur le bouton "Ajout BDD" (Bouton qui a la macro derrière), la macro vérifie en premier, donc AVANT de faire le job actuel, si le nom du nouveau salarié est déjà présent sur la BDD et affiche un Message box avec soit:

"Personne déjà présente dans la base de donnée" avec un bouton "OK" et du coup stop le reste du code et ferme la box,
Soit
"Personne pouvant être ajoutée à la base de donnée" avec un bouton "OK" et lance le reste du code.

J'ai tenté plusieurs chose en regardant à droite et à gauche concernant les message box, mais je bousille plutôt qu'autre chose mon code actuel ou le code continue à se lancer même si c'est KO.

Info supplémentaire:
1- Nom de l'onglet de la fiche: "Fiche New Salarié"
Le nom du salarié se trouve en cellule "H8"

2-Nom de l'onglet BDD: "BasedeDonnées"
Plage des noms des salariés existants : A3:A1000

3- Voici mon code actuel:

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
Sub Ajoutnewsalarie()
'
' Ajoutnewsalarie Macro
'
 
'
    Sheets("BasedeDonnées").Visible = True
    Sheets("BasedeDonnées").Select
    Sheets("BasedeDonnées").Unprotect Password:="XXXXXXX"
    Sheets("Fiche New Salarié").Select
    Range("H8:J8").Select
    Selection.Copy
    Sheets("BasedeDonnées").Select
    Dim derligne As Long
    derligne = Range("A65536").End(xlUp).Row + 1
    Cells(derligne, 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Dim F1 As Worksheet
Dim F2 As Worksheet
Set F1 = Sheets("BasedeDonnées")
Set F2 = Sheets("Fiche New Salarié")
Dim plage As Range
Set plage = F1.Range("A3:A1000")
codrecherché = F2.Range("H8").Value
Application.ScreenUpdating = False
For Each cell In plage
 If cell.Value = codrecherché Then
    F1.Cells(cell.Row, 2) = F2.Range("H9")
    F1.Cells(cell.Row, 3) = F2.Range("H10")
    F1.Cells(cell.Row, 5) = F2.Range("H11")
    F1.Cells(cell.Row, 8) = F2.Range("H12")
    F1.Cells(cell.Row, 14) = F2.Range("L12")
    F1.Cells(cell.Row, 9) = F2.Range("H13")
    F1.Cells(cell.Row, 15) = F2.Range("L13")
    F1.Cells(cell.Row, 10) = F2.Range("H14")
    F1.Cells(cell.Row, 16) = F2.Range("L14")
    F1.Cells(cell.Row, 7) = F2.Range("H15")
    F1.Cells(cell.Row, 6) = F2.Range("L15")
    F1.Cells(cell.Row, 17) = F2.Range("H16")
    F1.Cells(cell.Row, 18) = F2.Range("H17")
    F1.Cells(cell.Row, 13) = F2.Range("I23")
    F1.Cells(cell.Row, 22) = F2.Range("H24")
    F1.Cells(cell.Row, 23) = F2.Range("I24")
    F1.Cells(cell.Row, 24) = F2.Range("J24")
    F1.Cells(cell.Row, 27) = F2.Range("H25")
    F1.Cells(cell.Row, 28) = F2.Range("I25")
    F1.Cells(cell.Row, 29) = F2.Range("J25")
    F1.Cells(cell.Row, 32) = F2.Range("H26")
    F1.Cells(cell.Row, 33) = F2.Range("I26")
    F1.Cells(cell.Row, 34) = F2.Range("J26")
    F1.Cells(cell.Row, 37) = F2.Range("H27")
    F1.Cells(cell.Row, 38) = F2.Range("I27")
    F1.Cells(cell.Row, 39) = F2.Range("J27")
    F1.Cells(cell.Row, 42) = F2.Range("H28")
    F1.Cells(cell.Row, 43) = F2.Range("I28")
    F1.Cells(cell.Row, 44) = F2.Range("J28")
    F1.Cells(cell.Row, 47) = F2.Range("H29")
    F1.Cells(cell.Row, 48) = F2.Range("I29")
    F1.Cells(cell.Row, 49) = F2.Range("J29")
    F1.Cells(cell.Row, 52) = F2.Range("H30")
    F1.Cells(cell.Row, 53) = F2.Range("I30")
    F1.Cells(cell.Row, 54) = F2.Range("J30")
    F1.Cells(cell.Row, 57) = F2.Range("H31")
    F1.Cells(cell.Row, 58) = F2.Range("I31")
    F1.Cells(cell.Row, 59) = F2.Range("J31")
    F1.Cells(cell.Row, 62) = F2.Range("H32")
    F1.Cells(cell.Row, 63) = F2.Range("I32")
    F1.Cells(cell.Row, 64) = F2.Range("J32")
    F1.Cells(cell.Row, 67) = F2.Range("H33")
    F1.Cells(cell.Row, 68) = F2.Range("I33")
    F1.Cells(cell.Row, 69) = F2.Range("J33")
    F1.Cells(cell.Row, 72) = F2.Range("H34")
    F1.Cells(cell.Row, 73) = F2.Range("I34")
    F1.Cells(cell.Row, 74) = F2.Range("J34")
    F1.Cells(cell.Row, 77) = F2.Range("H35")
    F1.Cells(cell.Row, 78) = F2.Range("I35")
    F1.Cells(cell.Row, 79) = F2.Range("J35")
    F1.Cells(cell.Row, 82) = F2.Range("H36")
    F1.Cells(cell.Row, 83) = F2.Range("I36")
    F1.Cells(cell.Row, 84) = F2.Range("J36")
    F1.Cells(cell.Row, 87) = F2.Range("H37")
    F1.Cells(cell.Row, 88) = F2.Range("I37")
    F1.Cells(cell.Row, 89) = F2.Range("J37")
    F1.Cells(cell.Row, 92) = F2.Range("H38")
    F1.Cells(cell.Row, 93) = F2.Range("I38")
    F1.Cells(cell.Row, 94) = F2.Range("J38")
    F1.Cells(cell.Row, 97) = F2.Range("H39")
    F1.Cells(cell.Row, 98) = F2.Range("I39")
    F1.Cells(cell.Row, 99) = F2.Range("J39")
    F1.Cells(cell.Row, 102) = F2.Range("H40")
    F1.Cells(cell.Row, 103) = F2.Range("I40")
    F1.Cells(cell.Row, 104) = F2.Range("J40")
    F1.Cells(cell.Row, 107) = F2.Range("H41")
    F1.Cells(cell.Row, 108) = F2.Range("I41")
    F1.Cells(cell.Row, 109) = F2.Range("J41")
    F1.Cells(cell.Row, 112) = F2.Range("H42")
    F1.Cells(cell.Row, 113) = F2.Range("I42")
    F1.Cells(cell.Row, 114) = F2.Range("J42")
    F1.Cells(cell.Row, 117) = F2.Range("H43")
    F1.Cells(cell.Row, 118) = F2.Range("I43")
    F1.Cells(cell.Row, 119) = F2.Range("J43")
    F1.Cells(cell.Row, 122) = F2.Range("H44")
    F1.Cells(cell.Row, 123) = F2.Range("I44")
    F1.Cells(cell.Row, 124) = F2.Range("J44")
    F1.Cells(cell.Row, 127) = F2.Range("H45")
    F1.Cells(cell.Row, 128) = F2.Range("I45")
    F1.Cells(cell.Row, 129) = F2.Range("J45")
    F1.Cells(cell.Row, 132) = F2.Range("H46")
    F1.Cells(cell.Row, 133) = F2.Range("I46")
    F1.Cells(cell.Row, 134) = F2.Range("J46")
End If
    Next cell
    Application.ScreenUpdating = True
    ActiveWorkbook.Worksheets("BasedeDonnées").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("BasedeDonnées").AutoFilter.Sort.SortFields.Add2 Key _
        :=Range("A2:A1010"), SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("BasedeDonnées").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Sheets("BasedeDonnées").Protect Password:="XXXXXXX"
    Sheets("BasedeDonnées").Visible = False
    Sheets("Fiche New Salarié").Select
    Range("H8:J8").Select
End Sub

Je reste dispo si besoin d'info supplémentaire, bien évidement !

En vous remerciant d'avance pour votre aide...

**ChristianBosch** · 14/04/2021, 17h24

Salut,

Voici :

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
Sub Ajoutnewsalarie()
'
' Ajoutnewsalarie Macro
'
 
Dim cell As Range
For Each cell In Sheets("BasedeDonnées").Range("A3:A1000")
If Sheets("Fiche New Salarié").Range("h8").Value = cell.Value Then
    MsgBox "Personne déjà présente dans la base de donnée", vbExclamation
    GoTo fin
End If
Next cell
MsgBox "Personne pouvant être ajoutée à la base de donnée", vbInformation
 
Sheets("BasedeDonnées").Visible = True
Sheets("BasedeDonnées").Select
Sheets("BasedeDonnées").Unprotect Password:="XXXXXXX"
Sheets("Fiche New Salarié").Select
Range("H8:J8").Select
Selection.Copy
Sheets("BasedeDonnées").Select
Dim derligne As Long
derligne = Range("A65536").End(xlUp).Row + 1
Cells(derligne, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Dim F1 As Worksheet
Dim F2 As Worksheet
Set F1 = Sheets("BasedeDonnées")
Set F2 = Sheets("Fiche New Salarié")
Dim plage As Range
Set plage = F1.Range("A3:A1000")
codrecherché = F2.Range("H8").Value
Application.ScreenUpdating = False
For Each cell In plage
If cell.Value = codrecherché Then
F1.Cells(cell.Row, 2) = F2.Range("H9")
F1.Cells(cell.Row, 3) = F2.Range("H10")
F1.Cells(cell.Row, 5) = F2.Range("H11")
F1.Cells(cell.Row, 8) = F2.Range("H12")
F1.Cells(cell.Row, 14) = F2.Range("L12")
F1.Cells(cell.Row, 9) = F2.Range("H13")
F1.Cells(cell.Row, 15) = F2.Range("L13")
F1.Cells(cell.Row, 10) = F2.Range("H14")
F1.Cells(cell.Row, 16) = F2.Range("L14")
F1.Cells(cell.Row, 7) = F2.Range("H15")
F1.Cells(cell.Row, 6) = F2.Range("L15")
F1.Cells(cell.Row, 17) = F2.Range("H16")
F1.Cells(cell.Row, 18) = F2.Range("H17")
F1.Cells(cell.Row, 13) = F2.Range("I23")
F1.Cells(cell.Row, 22) = F2.Range("H24")
F1.Cells(cell.Row, 23) = F2.Range("I24")
F1.Cells(cell.Row, 24) = F2.Range("J24")
F1.Cells(cell.Row, 27) = F2.Range("H25")
F1.Cells(cell.Row, 28) = F2.Range("I25")
F1.Cells(cell.Row, 29) = F2.Range("J25")
F1.Cells(cell.Row, 32) = F2.Range("H26")
F1.Cells(cell.Row, 33) = F2.Range("I26")
F1.Cells(cell.Row, 34) = F2.Range("J26")
F1.Cells(cell.Row, 37) = F2.Range("H27")
F1.Cells(cell.Row, 38) = F2.Range("I27")
F1.Cells(cell.Row, 39) = F2.Range("J27")
F1.Cells(cell.Row, 42) = F2.Range("H28")
F1.Cells(cell.Row, 43) = F2.Range("I28")
F1.Cells(cell.Row, 44) = F2.Range("J28")
F1.Cells(cell.Row, 47) = F2.Range("H29")
F1.Cells(cell.Row, 48) = F2.Range("I29")
F1.Cells(cell.Row, 49) = F2.Range("J29")
F1.Cells(cell.Row, 52) = F2.Range("H30")
F1.Cells(cell.Row, 53) = F2.Range("I30")
F1.Cells(cell.Row, 54) = F2.Range("J30")
F1.Cells(cell.Row, 57) = F2.Range("H31")
F1.Cells(cell.Row, 58) = F2.Range("I31")
F1.Cells(cell.Row, 59) = F2.Range("J31")
F1.Cells(cell.Row, 62) = F2.Range("H32")
F1.Cells(cell.Row, 63) = F2.Range("I32")
F1.Cells(cell.Row, 64) = F2.Range("J32")
F1.Cells(cell.Row, 67) = F2.Range("H33")
F1.Cells(cell.Row, 68) = F2.Range("I33")
F1.Cells(cell.Row, 69) = F2.Range("J33")
F1.Cells(cell.Row, 72) = F2.Range("H34")
F1.Cells(cell.Row, 73) = F2.Range("I34")
F1.Cells(cell.Row, 74) = F2.Range("J34")
F1.Cells(cell.Row, 77) = F2.Range("H35")
F1.Cells(cell.Row, 78) = F2.Range("I35")
F1.Cells(cell.Row, 79) = F2.Range("J35")
F1.Cells(cell.Row, 82) = F2.Range("H36")
F1.Cells(cell.Row, 83) = F2.Range("I36")
F1.Cells(cell.Row, 84) = F2.Range("J36")
F1.Cells(cell.Row, 87) = F2.Range("H37")
F1.Cells(cell.Row, 88) = F2.Range("I37")
F1.Cells(cell.Row, 89) = F2.Range("J37")
F1.Cells(cell.Row, 92) = F2.Range("H38")
F1.Cells(cell.Row, 93) = F2.Range("I38")
F1.Cells(cell.Row, 94) = F2.Range("J38")
F1.Cells(cell.Row, 97) = F2.Range("H39")
F1.Cells(cell.Row, 98) = F2.Range("I39")
F1.Cells(cell.Row, 99) = F2.Range("J39")
F1.Cells(cell.Row, 102) = F2.Range("H40")
F1.Cells(cell.Row, 103) = F2.Range("I40")
F1.Cells(cell.Row, 104) = F2.Range("J40")
F1.Cells(cell.Row, 107) = F2.Range("H41")
F1.Cells(cell.Row, 108) = F2.Range("I41")
F1.Cells(cell.Row, 109) = F2.Range("J41")
F1.Cells(cell.Row, 112) = F2.Range("H42")
F1.Cells(cell.Row, 113) = F2.Range("I42")
F1.Cells(cell.Row, 114) = F2.Range("J42")
F1.Cells(cell.Row, 117) = F2.Range("H43")
F1.Cells(cell.Row, 118) = F2.Range("I43")
F1.Cells(cell.Row, 119) = F2.Range("J43")
F1.Cells(cell.Row, 122) = F2.Range("H44")
F1.Cells(cell.Row, 123) = F2.Range("I44")
F1.Cells(cell.Row, 124) = F2.Range("J44")
F1.Cells(cell.Row, 127) = F2.Range("H45")
F1.Cells(cell.Row, 128) = F2.Range("I45")
F1.Cells(cell.Row, 129) = F2.Range("J45")
F1.Cells(cell.Row, 132) = F2.Range("H46")
F1.Cells(cell.Row, 133) = F2.Range("I46")
F1.Cells(cell.Row, 134) = F2.Range("J46")
End If
Next cell
Application.ScreenUpdating = True
ActiveWorkbook.Worksheets("BasedeDonnées").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("BasedeDonnées").AutoFilter.Sort.SortFields.Add2 Key _
:=Range("A2:A1010"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("BasedeDonnées").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("BasedeDonnées").Protect Password:="XXXXXXX"
Sheets("BasedeDonnées").Visible = False
Sheets("Fiche New Salarié").Select
Range("H8:J8").Select
fin:
End Sub

**gouN40** · 14/04/2021, 17h36

Nikel, ça fonctionne !! Merci beaucoup

VBA- Ajout Message BOX [XL-365]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager