[XL-2007] Répéter une macro selon la valeur d'une ComboBox [Résolu]

[Jeromeric]

Bonjour à tous,

Voici ci dessous un code qui fonctionne et qui me permet de remplir une base de données depuis un UserForm :

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
Private Sub UserForm_Initialize()
Dim Fichier As String
Dim x As Long
Dim i As Long
 
'Chemin et nom du fichier icône à afficher
Fichier = "C:\Users\.ico"
'Vérifie si le fichier existe
If Dir(Fichier) = "" Then Exit Sub
 
x = ExtractIconA(0, Fichier, 0)
SendMessageA FindWindow(vbNullString, Me.Captde ion), &H80, False, x
 
'Definit les valeurs par défaut des ComboBox
ComboBox_NbreJours.Value = "0"
ComboBox_Intervention.Value = ""
 
For i = 1 To 8 '8 = nombre des cellules prises en compte dans le menu déroulant
ComboBox_NbreJours.AddItem Sheets("Listes").Cells(i, 1) '1 = n°colonne, c-a-d colonne A
ComboBox_Intervention.AddItem Sheets("Listes").Cells(i, 2) '1 = n°colonne, c-a-d colonne A
Next
End Sub
 
'Quand l'utilisateur clic sur le bouton Ok
Private Sub CommandButton_Ok_Click()
Dim i As Integer, Ligne As Long
If ComboBox_NbreJours = "" Then Exit Sub
For i = 1 To ComboBox_NbreJours.Value
 
    'Coloration des Labels en noir
    Label_Nmagasin.ForeColor = RGB(0, 0, 0)
    Label_Magasin.ForeColor = RGB(0, 0, 0)
    Label_NbreCaisses.ForeColor = RGB(0, 0, 0)
    Label_NbreJours.ForeColor = RGB(0, 0, 0)
    Label_Date.ForeColor = RGB(0, 0, 0)
    Label_Intervention.ForeColor = RGB(0, 0, 0)
 
    'Contôles de contenu
    If TextBox_Nmagasin.Value = "" Then 'Si rien de saisi dans N° de Magasin
        Label_Nmagasin.ForeColor = RGB(255, 0, 0) 'Label N° de Magasin passe en rouge
    ElseIf TextBox_Magasin.Value = "" Then
        Label_Magasin.ForeColor = RGB(255, 0, 0)
    ElseIf TextBox_NbreCaisses.Value = "" Then
        Label_NbreCaisses.ForeColor = RGB(255, 0, 0)
    ElseIf ComboBox_NbreJours.Value = "" Then
        Label_NbreJours.ForeColor = RGB(255, 0, 0)
    ElseIf DTPicker_Date.Value = "" Then
        Label_Date.ForeColor = RGB(255, 0, 0)
    ElseIf ComboBox_Intervention.Value = "" Then
        Label_Intervention.ForeColor = RGB(255, 0, 0)
    Else
 
        'Si le formulaire est complet, on insère les valeurs dans la feuille
        Dim no_ligne As Integer, Retour As String
 
        'no_ligne = N° de ligne de la dernière cellule non vide de la colonne +1
        Sheets("Base de Données").Select
        no_ligne = Range("A65536").End(xlUp).Row + 1
 
        'Insertion des valeurs sur la feuille
        Cells(no_ligne, 1) = TextBox_Nmagasin.Value
        Cells(no_ligne, 2) = TextBox_Magasin.Value
        Cells(no_ligne, 3) = TextBox_NbreCaisses.Value
        Cells(no_ligne, 4) = ComboBox_NbreJours.Value
        '
        Cells(no_ligne, 6) = ComboBox_Intervention.Value
        '
        Cells(no_ligne, 9) = DTPicker_Date.Value
 
        'Après insertion, on remet les valeurs initiales
 
        TextBox_Nmagasin.Value = ""
        TextBox_Magasin.Value = ""
        TextBox_NbreCaisses.Value = ""
        ComboBox_NbreJours.Value = ""
        ComboBox_Intervention.Value = ""
   End If
Next i
 
ActiveWorkbook.Save
MsgBox "L'enregistrement des données a été réalisé avec succés.", vbInformation + vbOKOnly, "Information"
 
End Sub

J'aimerais pouvoir modifier ce code afin que la valeur entrée dans "ComboBox_NbreJours" détermine le nombre de ligne incrémentée dans la base de données. C'est à dire, si 3 est entré dans nbre de jours, 3 lignes doivent être créees.

J'aimerais corsé le tout et faire aussi en sorte que les dates suivent les nombres de jours.

Enfin, est-il aussi possible de modifier la valeur de ComboBox_Intervention en fonction du nombre de jours indiqué ?

C'est à dire :
1 jour = 1 ligne créée avec ComboBox_Intervention = "Installation J1"
2 jours : 2 lignes créées avec ComboBox_Intervention = "Installation J1" puis "Installation J2" etc.

J'avoue être perdu et ne vois pas par où commencer. Quelqu'un aurait'il une piste s'il vous plaît ?

[Qwazerty]

Salut

Peut-être comme ça?

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
Private Sub UserForm_Initialize()
Dim Fichier As String
Dim x As Long
Dim i As Long
 
'Chemin et nom du fichier icône à afficher
Fichier = "C:\Users\.ico"
'Vérifie si le fichier existe
If Dir(Fichier) = "" Then Exit Sub
 
x = ExtractIconA(0, Fichier, 0)
SendMessageA FindWindow(vbNullString, Me.Caption), &H80, False, x
 
'Definit les valeurs par défaut des ComboBox
ComboBox_NbreJours.Value = "0"
ComboBox_Intervention.Value = ""
 
'Regarde du coté de la propriété RowSource (ou ControlSource) du combobox, tu peux pointer directement sur ton tableau excel
'tu peux définir cette propriété en mode création si tu le souhaites
For i = 1 To 8 '8 = nombre des cellules prises en compte dans le menu déroulant
ComboBox_NbreJours.AddItem Sheets("Listes").Cells(i, 1) '1 = n°colonne, c-a-d colonne A
ComboBox_Intervention.AddItem Sheets("Listes").Cells(i, 2) '1 = n°colonne, c-a-d colonne A
Next
End Sub
 
'Quand l'utilisateur clic sur le bouton Ok
Private Sub CommandButton_Ok_Click()
Dim i As Integer, Ligne As Long
If ComboBox_NbreJours = "" Then Exit Sub
For i = 1 To ComboBox_NbreJours.Value
 
    'Coloration des Labels en noir
    Label_Nmagasin.ForeColor = RGB(0, 0, 0)
    Label_Magasin.ForeColor = RGB(0, 0, 0)
    Label_NbreCaisses.ForeColor = RGB(0, 0, 0)
    Label_NbreJours.ForeColor = RGB(0, 0, 0)
    Label_Date.ForeColor = RGB(0, 0, 0)
    Label_Intervention.ForeColor = RGB(0, 0, 0)
 
    'Contôles de contenu
    If TextBox_Nmagasin.Value = "" Then 'Si rien de saisi dans N° de Magasin
        Label_Nmagasin.ForeColor = RGB(255, 0, 0) 'Label N° de Magasin passe en rouge
    ElseIf TextBox_Magasin.Value = "" Then
        Label_Magasin.ForeColor = RGB(255, 0, 0)
    ElseIf TextBox_NbreCaisses.Value = "" Then
        Label_NbreCaisses.ForeColor = RGB(255, 0, 0)
    ElseIf ComboBox_NbreJours.Value = "" Then
        Label_NbreJours.ForeColor = RGB(255, 0, 0)
    ElseIf DTPicker_Date.Value = "" Then
        Label_Date.ForeColor = RGB(255, 0, 0)
    ElseIf ComboBox_Intervention.Value = "" Then
        Label_Intervention.ForeColor = RGB(255, 0, 0)
    Else
 
        'Si le formulaire est complet, on insère les valeurs dans la feuille
        'Dim no_ligne As Integer, Retour As String
 
        'Si j'ai bien compris ta demande
        For i = 1 To CInt(ComboBox_NbreJours.Value)
            'no_ligne = N° de ligne de la dernière cellule non vide de la colonne +1
            'Pour éviter les suprises en cas de feuille active différente
            With Sheets("Base de Données") '.Select
                With .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
 
                    'Insertion des valeurs sur la feuille
                    .Value = TextBox_Nmagasin.Value
                    .Offset(0, 1) = TextBox_Magasin.Value
                    .Offset(0, 2) = TextBox_NbreCaisses.Value
                    .Offset(0, 3) = ComboBox_NbreJours.Value
                    '
                    .Offset(0, 4) = ComboBox_Intervention.Value
                    '
                    .Offset(0, 5) = DTPicker_Date.Value
 
                    'Après insertion, on remet les valeurs initiales
 
                    TextBox_Nmagasin.Value = ""
                    TextBox_Magasin.Value = ""
                    TextBox_NbreCaisses.Value = ""
                    ComboBox_NbreJours.Value = ""
                    ComboBox_Intervention.Value = ""
                End With
            End With
        Next
   End If
Next i
 
ActiveWorkbook.Save
MsgBox "L'enregistrement des données a été réalisé avec succés.", vbInformation + vbOKOnly, "Information"
 
End Sub

Regarde les commentaires, il y a surement des choses a faire pour définir le contenu des Combo sans passer par du code.

++
Qwaz

[Jeromeric]

Bonjour,

Merci pour ta réponse, j'ai fait quelques recherches sur la propriété Rowsource et effectivement je parviens à remplir les combobox sans code. En bon débutant que je suis, plus c'est simple mieux c'est alors merci

Par contre, j'ai du modifier le code en partie car en l'état j'avais quelques bugs. Voici le code en ce moment :

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
Private Sub CommandButton_Ok_Click()
Dim i As Integer, Ligne As Long
 
    'Coloration des Labels en noir
    Label_Nmagasin.ForeColor = RGB(0, 0, 0)
    Label_Magasin.ForeColor = RGB(0, 0, 0)
    Label_NbreCaisses.ForeColor = RGB(0, 0, 0)
    Label_NbreJours.ForeColor = RGB(0, 0, 0)
    Label_Date.ForeColor = RGB(0, 0, 0)
    Label_Intervention.ForeColor = RGB(0, 0, 0)
 
    'Contôles de contenu
    If TextBox_Nmagasin.Value = "" Then 'Si rien de saisi dans N° de Magasin
        Label_Nmagasin.ForeColor = RGB(255, 0, 0) 'Label N° de Magasin passe en rouge
    ElseIf TextBox_Magasin.Value = "" Then
        Label_Magasin.ForeColor = RGB(255, 0, 0)
    ElseIf TextBox_NbreCaisses.Value = "" Then
        Label_NbreCaisses.ForeColor = RGB(255, 0, 0)
    ElseIf ComboBox_NbreJours.Value = "" Then
        Label_NbreJours.ForeColor = RGB(255, 0, 0)
    ElseIf DTPicker_Date.Value = "" Then
        Label_Date.ForeColor = RGB(255, 0, 0)
    ElseIf ComboBox_Intervention.Value = "" Then
        Label_Intervention.ForeColor = RGB(255, 0, 0)
    Else
 
        'Si le formulaire est complet, on insère les valeurs dans la feuille
        'Dim no_ligne As Integer, Retour As String
 
        'Si j'ai bien compris ta demande
        For i = 1 To CInt(ComboBox_NbreJours.Value)
            With Sheets("Base de Données") '.Select
                With .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
 
                    'Insertion des valeurs sur la feuille
                    .Value = TextBox_Nmagasin.Value
                    .Offset(0, 1) = TextBox_Magasin.Value
                    .Offset(0, 2) = TextBox_NbreCaisses.Value
                    .Offset(0, 3) = ComboBox_NbreJours.Value
                    '
                    .Offset(0, 4) = ComboBox_Intervention.Value
                    '
                    .Offset(0, 5) = DTPicker_Date.Value
 
                    'Après insertion, on remet les valeurs initiales
 
                    TextBox_Nmagasin.Value = ""
                    TextBox_Magasin.Value = ""
                    TextBox_NbreCaisses.Value = ""
                    ComboBox_NbreJours.Value = ""
                    ComboBox_Intervention.Value = ""
                End With
            End With
        Next
   End If
 
ActiveWorkbook.Save
MsgBox "L'enregistrement des données a été réalisé avec succés.", vbInformation + vbOKOnly, "Information"
 
End Sub

Malgré les modifications apportées voici les problèmes que se posent toujours :

- une seconde date est bien ajoutée dans la ligne suivante si je choisis 2 dans la combobox NbreJours, par contre cette nouvelle date ne suit pas la première. Et 1 date au maximum peut être ajoutée même si on choisit 3 ou + dans la combobox.
- les valeurs des autres cellules ne se copient pas au moment de la création des lignes supplémentaires (seule la date)
- la fonction qui me permettait de stopper l'insertion des données si une valeure n'était pas renseignée dans l'USF ne fonctionne plus. Là je peux valider un USF vierge et la fenêtre "Enregistrement des données ok" s'affiche quand même.

Vois-tu ce qui se passe ?

[Qwazerty]

Salut

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
Private Sub CommandButton_Ok_Click()
Dim i As Integer, Ligne As Long
 
    'Coloration des Labels en noir
    Label_Nmagasin.ForeColor = RGB(0, 0, 0)
    Label_Magasin.ForeColor = RGB(0, 0, 0)
    Label_NbreCaisses.ForeColor = RGB(0, 0, 0)
    Label_NbreJours.ForeColor = RGB(0, 0, 0)
    Label_Date.ForeColor = RGB(0, 0, 0)
    Label_Intervention.ForeColor = RGB(0, 0, 0)
 
    'Contôles de contenu
    If TextBox_Nmagasin.Value = "" Then 'Si rien de saisi dans N° de Magasin
        Label_Nmagasin.ForeColor = RGB(255, 0, 0) 'Label N° de Magasin passe en rouge
    ElseIf TextBox_Magasin.Value = "" Then
        Label_Magasin.ForeColor = RGB(255, 0, 0)
    ElseIf TextBox_NbreCaisses.Value = "" Then
        Label_NbreCaisses.ForeColor = RGB(255, 0, 0)
    ElseIf ComboBox_NbreJours.Value = "" Then
        Label_NbreJours.ForeColor = RGB(255, 0, 0)
    ElseIf DTPicker_Date.Value = "" Then
        Label_Date.ForeColor = RGB(255, 0, 0)
    ElseIf ComboBox_Intervention.Value = "" Then
        Label_Intervention.ForeColor = RGB(255, 0, 0)
    Else
 
        'Si le formulaire est complet, on insère les valeurs dans la feuille
        'Dim no_ligne As Integer, Retour As String
 
        'Si j'ai bien compris ta demande
        For i = 1 To CInt(ComboBox_NbreJours.Value)
            With Sheets("Base de Données") '.Select
                With .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
 
                    'Insertion des valeurs sur la feuille
                    .Value = TextBox_Nmagasin.Value
                    .Offset(0, 1) = TextBox_Magasin.Value
                    .Offset(0, 2) = TextBox_NbreCaisses.Value
                    .Offset(0, 3) = ComboBox_NbreJours.Value
                    '
                    .Offset(0, 4) = ComboBox_Intervention.Value
                    '
                    .Offset(0, 5) = DTPicker_Date.Value
 
                End With
            End With
        Next
        'Il faut vider les textbox qu'a la fin des insertions
        'Après insertion, on remet les valeurs initiales
 
        TextBox_Nmagasin.Value = ""
        TextBox_Magasin.Value = ""
        TextBox_NbreCaisses.Value = ""
        ComboBox_NbreJours.Value = ""
        ComboBox_Intervention.Value = ""
 
        'Et n'afficher le message que si tout etait ok
        ActiveWorkbook.Save
        MsgBox "L'enregistrement des données a été réalisé avec succés.", vbInformation + vbOKOnly, "Information"
   End If
 
 
End Sub

Je ne comprend pas pour la date, il faut incrtémenter la date? d'un jour a chaque fois?
Si c'est le cas

Code :

.Offset(0, 5) = DTPicker_Date.Value + (i-1)

++
Qwaz

[Jeromeric]

Merci tout fonctionne

C'était bien

Code :

.Offset(0, 5) = DTPicker_Date.Value + (i-1)

qui m'intéressait.

De la même manière, et ce sera ma dernière question. Est-il aussi possible d'incrémenter de 1 la ComboBox_Intervention.Value. Je m'explique : La valeur de la combobox sera quelque chose comme "Prestation J1", je voudrais que sur les nouvelles lignes soient renseigné "Prestation J2", "Prestation J3" etc.

Merci d'avance.

[Qwazerty]

Salut

Une solution

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
Option Explicit
 
Private Sub CommandButton_Ok_Click()
Dim i As Integer, Ligne As Long
Dim vValeur As Variant, sValeur As String
 
    'Coloration des Labels en noir
    Label_Nmagasin.ForeColor = RGB(0, 0, 0)
    Label_Magasin.ForeColor = RGB(0, 0, 0)
    Label_NbreCaisses.ForeColor = RGB(0, 0, 0)
    Label_NbreJours.ForeColor = RGB(0, 0, 0)
    Label_Date.ForeColor = RGB(0, 0, 0)
    Label_Intervention.ForeColor = RGB(0, 0, 0)
 
    'Contôles de contenu
    If TextBox_Nmagasin.Value = "" Then 'Si rien de saisi dans N° de Magasin
        Label_Nmagasin.ForeColor = RGB(255, 0, 0) 'Label N° de Magasin passe en rouge
    ElseIf TextBox_Magasin.Value = "" Then
        Label_Magasin.ForeColor = RGB(255, 0, 0)
    ElseIf TextBox_NbreCaisses.Value = "" Then
        Label_NbreCaisses.ForeColor = RGB(255, 0, 0)
    ElseIf ComboBox_NbreJours.Value = "" Then
        Label_NbreJours.ForeColor = RGB(255, 0, 0)
    ElseIf DTPicker_Date.Value = "" Then
        Label_Date.ForeColor = RGB(255, 0, 0)
    ElseIf ComboBox_Intervention.Value = "" Then
        Label_Intervention.ForeColor = RGB(255, 0, 0)
    Else
 
        'Si le formulaire est complet, on insère les valeurs dans la feuille
        'Dim no_ligne As Integer, Retour As String
        'On s'occupe du contenu du combo ComboBox_Intervention
        'Il faudra faire un code un peut plus complexe si le nombre qui suit J peut contenir 2 caractere
        'Ou pour rester dans le simple, prend en compte les 2 derniers caracteres et note toujour la valeur sur 2 caractere
        'PrestationJ01... J06... J10 ... J99
        vValeur = Right(ComboBox_Intervention.Text, 1) 'dans ce cas mettre 2 à la place de 1 ;)
        If IsNumeric(vValeur) Then
            'On conserve la partie fix
            sValeur = Left(ComboBox_Intervention, Len(ComboBox_Intervention) - 1) 'mettre -2 si formaté sur 2 caracteres
        Else
            'Il y a un soucis la partie n'est pas numeric à toi de voir ce que tu veux faire
        End If
        'Si j'ai bien compris ta demande
        For i = 1 To CInt(ComboBox_NbreJours.Value)
            With Sheets("Base de Données") '.Select
                With .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
 
                    'Insertion des valeurs sur la feuille
                    .Value = TextBox_Nmagasin.Value
                    .Offset(0, 1) = TextBox_Magasin.Value
                    .Offset(0, 2) = TextBox_NbreCaisses.Value
                    .Offset(0, 3) = ComboBox_NbreJours.Value
                    '
                    .Offset(0, 4) = sValeur & (CInt(vValeur) + (i - 1))
                    '
                    .Offset(0, 5) = DTPicker_Date.Value + (i - 1)
 
                End With
            End With
        Next
        'Il faut vider les textbox qu'a la fin des insertions
        'Après insertion, on remet les valeurs initiales
 
        TextBox_Nmagasin.Value = ""
        TextBox_Magasin.Value = ""
        TextBox_NbreCaisses.Value = ""
        ComboBox_NbreJours.Value = ""
        ComboBox_Intervention.Value = ""
 
        'Et n'afficher le message que si tout etait ok
        ActiveWorkbook.Save
        MsgBox "L'enregistrement des données a été réalisé avec succés.", vbInformation + vbOKOnly, "Information"
   End If
 
 
End Sub

++
Qwaz

[Jeromeric]

Salut,

Cette solution me va bien, je ne devrais pas dépasser Prestation J7 donc c'est parfait.

En tous cas, merci beaucoup pour les commentaires à chaque étape du code, j'ai déjà compris quelques une de mes erreurs. Je vais me pencher sur les autres.

A+
Jérôme