Envoyer les données d'une listbox multisélection dans une cellule excel et format date

**ericfalcon** · 12/11/2024, 13h53

Bonjour.

J'essai de créer un tableau de suivi de mes candidats à la VAE.

Depuis le 25 octobre le mode de financement a été modifié. Je dois ajouter tous les modes de financements disponibles.

J'ai créé une listbox dans mon userform avec sélection multiple, puisque le candidat peut avoir diverses sources de financement.

J'ai une erreur lorsque je veux enregistrer cette donnée dans ma feuille excel.

Par ailleurs, j'ai l'impression que lorsque j'envoi les données de dates de mon formulaire vers mon fichier, les date sont au format texte. Ce qui m'ennuie car j'ai une formule si pour indiquer la dernière étape où il y a une date entrée.

Il serait peut être intéressant que, en mode création ou en mode modification, un calendrier permettant de sélectionner une date s'affiche systématiquement.

Voici une copie sans les noms de mon fichier.suivi candidats avec financement - Copie.xlsm suivi candidats avec financement - Copie.xlsm

**Philippe Tulliez** · 12/11/2024, 14h50

Bonjour,
J'ai écrit deux billets sur un sujet proche de votre demande. La lecture de ceux-ci vous aideront peut-être

VBA - Fonction qui renvoie une chaîne de caractères des éléments sélectionnés dans un ListBox
VBA - Fonction qui sélectionne les éléments d'un ListBox (MultiSelect) en fonction d'une chaîne de caractères

**ericfalcon** · 12/11/2024, 16h00

Bonjour.
Je n'ai pas su les adapter dans mon code

**Jean-Philippe André** · 12/11/2024, 16h26

Bonjour,

quel est ton code, quels sont tes essais ?

Les fichiers avec macros sont bloqués au téléchargement, ca va nous prendre du concret stp

**ericfalcon** · 12/11/2024, 16h39

Envoyé par Jean-Philippe André

Bonjour,

Les fichiers avec macros sont bloqués au téléchargement, ca va nous prendre du concret stp

Il y a beaucoup de codes pour mon userform qui fonctionnait jusqu'à ce que j'ajoute le champs type de financement

Pour débloquer les fichiers téléchargés, il faut :
- aller dans l'explorateur de fichier
- sélectionner le répertoire téléchargements
- faire un clic droit sur le fichier téléchargé puis sélectionner Propriétés
- en bas à droite, il y a une case à cocher Débloquer, qu'il faut cocher
- faire OK.
Le fichier est ensuite parfaitement utilisable

**ericfalcon** · 12/11/2024, 16h41

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
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
'
Option Explicit
' Déclaration des variables et constantes de portées module
Enum Status ' Constantes énumérées Status
 Consultation = 0: Modify = 1: NewRec = 2: Remove = 3
End Enum
Const StatusLabel As String = "Consultation;Modification;Création;Suppression"
Const appTitle As String = "SUIVI DES CANDIDATS VAE - Eric FALCON"
Dim UserFormStatus As Byte ' Statut du type de travail (Consultation, Modify, NewRec, Remove)
Dim CurrentRecord As Long  ' Enregistrement en cours
Dim rng As Range           ' Plage de données traitée par le formulaire
Dim lstStatusText() As String
 
 
Private Sub UserForm_Activate()
 InitVariable ' Initialisation des variables
 InitData     ' Initialisation adresse liste des données + RowSource
 InitComboBox ' Initialisation ComboBox
 InitListBox 'initialisation ListBox
 UserFormStatus = Status.Consultation ' Consultation par défaut
 With Me      ' Initialisation de certains contrôles
 .frmConfirm.Visible = False:
 .cboCandidat.Enabled = True: .frmMember.Enabled = False
 usfTitle     ' Titre du UserForm (Propriété Caption)
 End With
 ' Focus sur le 1er enregistrement ou l'enregistrement sélectionné dans la feuille
 With Me: .cboCandidat.ListIndex = Me.Tag: End With
End Sub
 
Private Sub InitVariable()
 lstStatusText = Split(StatusLabel, ";")
 With Me
 '.optMale.GroupName = "Gender": Me.optFemale.GroupName = "Gender"
  If Len(.Tag) = 0 Then .Tag = 0
 End With
End Sub
 
Private Sub InitComboBox()
 With Me.cboCandidat
 .ColumnHeads = True: .ColumnCount = 4: .ColumnWidths = "0;40;40;50"
 End With
 InitRowSource '
End Sub
Private Sub InitListBox()
With Me.cboCandidat
End With
ListBox1.RowSource = "Données!F1:F6"
End Sub
 
Private Sub InitData()
 ' Redimensionnement de l'objet rng et RowSource
 Set rng = Worksheets("SUIVI").Range("A2").CurrentRegion
 With rng
  Set rng = .Offset(1).Resize(.Rows.Count - 1)
 End With
End Sub
 
Private Sub InitRowSource()
 With Me.cboCandidat
 .RowSource = rng.Address(external:=True)
 .ListIndex = 0 ' Force la sélection du premier enregistrement
 End With
End Sub
 
Private Sub cboCandidat_Click()
 CurrentRecord = Me.cboCandidat.ListIndex
 ReadRecord CurrentRecord ' Lecture de l'enregistrement sélectionné
 CheckButton
End Sub
 
Private Sub cmdCancel_Click()
 ReadRecord CurrentRecord
 OppositeStatus ' Inverse la valeur booléenne des boutons d'action
End Sub
 
Private Sub cmdConfirm_Click()
 Select Case UserFormStatus
   Case Status.NewRec ' Nouvel enregistrement
     WriteRecord rng.Rows.Count: InitData: InitRowSource
     Me.cboCandidat.ListIndex = rng.Rows.Count - 1
   Case Status.Modify: WriteRecord CurrentRecord ' Modification de l'enregistrement
 End Select
 OppositeStatus ' Inverse la valeur booléenne des boutons d'action
End Sub
 
Private Sub cmdExit_Click()
 Unload Me ' Fermeture du UserForm
End Sub
 
Private Sub cmdModify_Click()
 UserFormStatus = Status.Modify
 OppositeStatus ' Inverse la valeur booléenne des boutons d'action
End Sub
 
Private Sub cmdNew_Click()
 UserFormStatus = Status.NewRec
 ClearTextBox   ' Efface les valeurs des TextBox
 OppositeStatus ' Inverse la valeur booléenne des boutons d'action
End Sub
 
Private Sub ClearTextBox()
 ' Efface toutes les valeurs contenues dans les contrôles TextBox du frame nommé frmMember
 Dim Ctrl As Control
 For Each Ctrl In Me.frmMember.Controls
  If TypeOf Ctrl Is MSForms.TextBox Then Ctrl.Value = ""
 Next
End Sub
 
Private Sub RemoveRecord(ByVal RecordNumber As Long)
 ' Suppression de l'enregistrement
 ' Contrainte : il doit rester un enregistrement
 Select Case True
  Case rng.Rows.Count = 1 ' Reste 1 enregistrement
    MsgBox "Vous devez laisser un enregistrement", vbInformation, "Suppression impossible"
  Case MsgBox("Voulez-vous supprimer la ligne sélectionnée", _
            vbCritical + vbYesNo + vbDefaultButton2, _
            "Suppression de la ligne " & CurrentRecord + 1) = vbYes
     RecordNumber = RecordNumber + 1
     rng.Rows(RecordNumber).Delete Shift:=xlUp ' Supprime la ligne de la plage
     InitData      ' Initialisation des variables objets
     InitRowSource ' Initialisation de la propriété RowSource
     CurrentRecord = 0: Me.cboCandidat.ListIndex = CurrentRecord
 End Select
 UserFormStatus = Status.Consultation
End Sub
 
Private Sub cmdNext_Click()
 Me.cboCandidat.ListIndex = CurrentRecord + 1
End Sub
 
Private Sub cmdPrevious_Click()
 Me.cboCandidat.ListIndex = CurrentRecord - 1
End Sub
 
Private Sub cmdFirst_Click()
 Me.cboCandidat.ListIndex = 0
End Sub
 
Private Sub cmdLast_Click()
 Me.cboCandidat.ListIndex = rng.Rows.Count - 1
End Sub
 
Private Sub cmdRemove_Click()
 UserFormStatus = Status.Remove: usfTitle
 RemoveRecord CurrentRecord ' Supprime l'enregistrement courant
 UserFormStatus = Status.Consultation: usfTitle
End Sub
 
Private Sub ReadRecord(ByVal RecordNumber As Long)
 ' Lecture de l'enregistrement
 RecordNumber = RecordNumber + 1
 With rng
 
  Me.Ref = Format(.Cells(RecordNumber, 1), "R000")
  Me.Nom1 = .Cells(RecordNumber, 2)
  Me.prenom1 = .Cells(RecordNumber, 3)
  Me.email1 = .Cells(RecordNumber, 4)
  Me.adresse1 = .Cells(RecordNumber, 5)
  Me.code1 = Format(.Cells(RecordNumber, 6), "00 000")
  Me.statut1 = .Cells(RecordNumber, 7)
  Me.num_demandeur_emploi1 = Format(.Cells(RecordNumber, 8), "0000000@")
  Me.type_financement1 = .Cells(RecordNumber, 9)
  Me.suivi_etape1 = .Cells(RecordNumber, 10)
  Me.remarque1 = .Cells(RecordNumber, 11)
  Me.diplome1 = .Cells(RecordNumber, 12)
  Me.date_contact1 = Format(.Cells(RecordNumber, 13), "dd/mm/yyyy")
  Me.date_faisabilite1 = Format(.Cells(RecordNumber, 14), "dd/mm/yyyy")
  Me.accord_faisabilite1 = Format(.Cells(RecordNumber, 15), "dd/mm/yyyy")
  Me.kairos1 = Format(.Cells(RecordNumber, 16), "dd/mm/yyyy")
  Me.demande_afgsu1 = Format(.Cells(RecordNumber, 17), "dd/mm/yyyy")
  Me.date_session_afgsu1 = Format(.Cells(RecordNumber, 18), "dd/mm/yyyy")
  Me.demande_financement1 = Format(.Cells(RecordNumber, 19), "dd/mm/yyyy")
  Me.financement1 = Format(.Cells(RecordNumber, 20), "dd/mm/yyyy")
  Me.date_RDV1 = Format(.Cells(RecordNumber, 21), "dd/mm/yyyy")
  Me.date_prev_depot1 = Format(.Cells(RecordNumber, 22), "dd/mm/yyyy")
  Me.date_RDV2 = Format(.Cells(RecordNumber, 23), "dd/mm/yyyy")
  Me.date_RDV3 = Format(.Cells(RecordNumber, 24), "dd/mm/yyyy")
  Me.date_RDV4 = Format(.Cells(RecordNumber, 25), "dd/mm/yyyy")
  Me.date_RDV5 = Format(.Cells(RecordNumber, 26), "dd/mm/yyyy")
  Me.date_RDV6 = Format(.Cells(RecordNumber, 27), "dd/mm/yyyy")
  Me.date_RDV7 = Format(.Cells(RecordNumber, 28), "dd/mm/yyyy")
  Me.date_RDV8 = Format(.Cells(RecordNumber, 29), "dd/mm/yyyy")
  Me.date_RDV9 = Format(.Cells(RecordNumber, 30), "dd/mm/yyyy")
  Me.date_RDV10 = Format(.Cells(RecordNumber, 31), "dd/mm/yyyy")
  Me.date_RDV11 = Format(.Cells(RecordNumber, 32), "dd/mm/yyyy")
  Me.date_RDV12 = Format(.Cells(RecordNumber, 33), "dd/mm/yyyy")
  Me.date_RDV13 = Format(.Cells(RecordNumber, 34), "dd/mm/yyyy")
  Me.date_RDV14 = Format(.Cells(RecordNumber, 35), "dd/mm/yyyy")
  Me.date_RDV15 = Format(.Cells(RecordNumber, 36), "dd/mm/yyyy")
  Me.date_RDV16 = Format(.Cells(RecordNumber, 37), "dd/mm/yyyy")
  Me.date_RDV17 = Format(.Cells(RecordNumber, 38), "dd/mm/yyyy")
  Me.date_RDV18 = Format(.Cells(RecordNumber, 39), "dd/mm/yyyy")
  Me.date_depot1 = Format(.Cells(RecordNumber, 40), "dd/mm/yyyy")
  Me.date_facture1 = Format(.Cells(RecordNumber, 41), "dd/mm/yyyy")
  Me.date_jury1 = Format(.Cells(RecordNumber, 42), "dd/mm/yyyy")
  Me.post_jury1 = Format(.Cells(RecordNumber, 43), "dd/mm/yyyy")
 
 
   Me.frmMember.Caption = "Fiche " & Format(RecordNumber, "R000")
 End With
End Sub
 
Private Sub WriteRecord(ByVal RecordNumber As Long)
 ' Ecriture de l'enregistrement
 Me.cboCandidat.ListIndex = -1
 RecordNumber = RecordNumber + 1
 With rng
  With .Cells(RecordNumber, 1)
   If Len(.Value) = 0 Then ' ID
    .Value = Application.WorksheetFunction.Max(rng.Columns(1)) + 1
   End If
   End With
  .Cells(RecordNumber, 1) = Format(Me.Ref, "R000")
  .Cells(RecordNumber, 2) = Me.Nom1
  .Cells(RecordNumber, 3) = Me.prenom1
  .Cells(RecordNumber, 4) = Me.email1
  .Cells(RecordNumber, 5) = Me.adresse1
  .Cells(RecordNumber, 6) = Format(Me.code1, "00 000")
  .Cells(RecordNumber, 7) = Me.statut1
  .Cells(RecordNumber, 8) = Format(Me.num_demandeur_emploi1, "0000000@")
  .Cells(RecordNumber, 9) = Me.type_financement1
  '.cells(RecordNumber,10)=Me.suivi_etape1
  .Cells(RecordNumber, 11) = Me.remarque1
  .Cells(RecordNumber, 12) = Me.diplome1
  .Cells(RecordNumber, 13) = Format(Me.date_contact1, "dd/mm/yyyy")
  .Cells(RecordNumber, 14) = Format(Me.date_faisabilite1, "dd/mm/yyyy")
  .Cells(RecordNumber, 15) = Format(Me.accord_faisabilite1, "dd/mm/yyyy")
  .Cells(RecordNumber, 16) = Format(Me.kairos1, "dd/mm/yyyy")
  .Cells(RecordNumber, 17) = Format(Me.demande_afgsu1, "dd/mm/yyyy")
  .Cells(RecordNumber, 18) = Format(Me.date_session_afgsu1, "dd/mm/yyyy")
  .Cells(RecordNumber, 19) = Format(Me.demande_financement1, "dd/mm/yyyy")
  .Cells(RecordNumber, 20) = Format(Me.financement1, "dd/mm/yyyy")
  .Cells(RecordNumber, 21) = Format(Me.date_RDV1, "dd/mm/yyyy")
  .Cells(RecordNumber, 22) = Format(Me.date_prev_depot1, "dd/mm/yyyy")
  .Cells(RecordNumber, 23) = Format(Me.date_RDV2, "dd/mm/yyyy")
  .Cells(RecordNumber, 24) = Format(Me.date_RDV3, "dd/mm/yyyy")
  .Cells(RecordNumber, 25) = Format(Me.date_RDV4, "dd/mm/yyyy")
  .Cells(RecordNumber, 26) = Format(Me.date_RDV5, "dd/mm/yyyy")
  .Cells(RecordNumber, 27) = Format(Me.date_RDV6, "dd/mm/yyyy")
  .Cells(RecordNumber, 28) = Format(Me.date_RDV7, "dd/mm/yyyy")
  .Cells(RecordNumber, 29) = Format(Me.date_RDV8, "dd/mm/yyyy")
  .Cells(RecordNumber, 30) = Format(Me.date_RDV9, "dd/mm/yyyy")
  .Cells(RecordNumber, 31) = Format(Me.date_RDV10, "dd/mm/yyyy")
  .Cells(RecordNumber, 32) = Format(Me.date_RDV11, "dd/mm/yyyy")
  .Cells(RecordNumber, 33) = Format(Me.date_RDV12, "dd/mm/yyyy")
  .Cells(RecordNumber, 34) = Format(Me.date_RDV13, "dd/mm/yyyy")
  .Cells(RecordNumber, 35) = Format(Me.date_RDV14, "dd/mm/yyyy")
  .Cells(RecordNumber, 36) = Format(Me.date_RDV15, "dd/mm/yyyy")
  .Cells(RecordNumber, 37) = Format(Me.date_RDV16, "dd/mm/yyyy")
  .Cells(RecordNumber, 38) = Format(Me.date_RDV17, "dd/mm/yyyy")
  .Cells(RecordNumber, 39) = Format(Me.date_RDV18, "dd/mm/yyyy")
  .Cells(RecordNumber, 40) = Format(Me.date_depot1, "dd/mm/yyyy")
  .Cells(RecordNumber, 41) = Format(Me.date_facture1, "dd/mm/yyyy")
  .Cells(RecordNumber, 42) = Format(Me.date_jury1, "dd/mm/yyyy")
  .Cells(RecordNumber, 42) = Format(Me.post_jury1, "dd/mm/yyyy")
 
 End With
 Me.cboCandidat.ListIndex = CurrentRecord
End Sub
 
Sub OppositeStatus()
 ' Inverse la valeur booléenne des boutons d'action
 ' Modifie la propriété Caption du UserForm
 With Me
 .cboCandidat.Enabled = Not .cboCandidat.Enabled
 .frmMember.Enabled = Not .frmMember.Enabled
 .frmAction.Visible = Not .frmAction.Visible
 .frmConfirm.Visible = Not .frmConfirm.Visible
  .cmdExit.Visible = Not .cmdExit.Visible
 .frmNavigation.Visible = Not .frmNavigation.Visible
  If .cboCandidat.Enabled = True Then UserFormStatus = Status.Consultation ' Consultation
  usfTitle ' Titre du UserForm
 End With
End Sub
 
Private Function usfTitle()
 ' Modifie la propriété Caption du UserForm
 Me.Caption = appTitle & " - " & lstStatusText(UserFormStatus)
End Function
 
Sub CheckButton()
 With Me
 .cmdFirst.Enabled = CurrentRecord > 0
 .cmdPrevious.Enabled = CurrentRecord > 0
 .cmdNext.Enabled = CurrentRecord <> rng.Rows.Count - 1
 .cmdLast.Enabled = CurrentRecord <> rng.Rows.Count - 1
 End With
End Sub
 
Private Sub UserForm_Terminate()
 Set rng = Nothing
 MsgBox "Au revoir"
End Sub
 
 
Private Sub statut1_Change()
 If statut1 <> "DEMANDEUR D'EMPLOI" Then
  Me.demandeur.Visible = False
 Else
  Me.demandeur.Visible = True
 End If
End Sub
 
Private Sub diplome1_Change()
 If Me.diplome1 = ("DE AS") Then
  Me.afgsu.Visible = True
 Else
  If Me.diplome1 = ("DE Aux Puer") Then
  Me.afgsu.Visible = True
   Else
   Me.afgsu.Visible = False
  End If
 End If
End Sub
 
Private Sub type_financement1_Click()
If .Me.type_financement1 = ("Financement France VAE") Then
Me.finacemnt.Visible = True
End Sub

**Philippe Tulliez** · 12/11/2024, 17h10

Bonjour,

Envoyé par ericfalcon

Bonjour.
Je n'ai pas su les adapter dans mon code

C'est étonnant car ce sont des fonctions génériques qui doivent pouvoir s'adapter à toutes situations

**Philippe Tulliez** · 12/11/2024, 17h31

Bonjour,
Je vois que vous utilisez pour votre UserForm, un code que j'ai publié dans une contribution datant de janvier 2015 titrée USERFORM - Créer, Consulter, Modifier et Supprimer des enregistrements à l'aide d'un formulaire. or dans cette contribution, j'ai publié une nouvelle version avec de nouvelles procédures (fil #28 titré USERFORM CRUD - Version 3,2) qui traitent justement du sujet de votre question initiale, à savoir la gestion d'un ListBox avec multi selection

**ericfalcon** · 12/11/2024, 18h47

Oui, c'est un formulaire que j'ai trouvé vraiment super et bien adapté à mon besoin.
je n'avais pas vu qu'il y avait une nouvelle version (cela dit sans le changement du financement, je n'en avais pas besoin)

**ericfalcon** · 13/11/2024, 12h57

Bonjour
J'ai complété en utilisant la version 3.2. Cela fonctionne parfaitement
Il demeure un problème : le numéro de Ref n'est pas complété lorsque l'on ajoute un nouvel enregistrement

Envoyer les données d'une listbox multisélection dans une cellule excel et format date [XL-365]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager