[VBA-E] Form Excel VB, remplissage automatique d'un tableau

Version imprimable

05/04/2007, 13h06
evema

1 pièce(s) jointe(s)

[VBA-E] Form Excel VB, remplissage automatique d'un tableau

Bonjour,

(cf pièce jointe pour une meilleure compréhension, et merci d'avance à ceux qui pourront m'aider...)

Le but est de continuer le remplissage du tableau de l'onglet "list of reports" automatiquement, à l'aide du formulaire généré par le bouton de mise à jour sur le même onglet.

Les champs doivent se remplir automatiquement, et si la sélection est mutiple pour une Frame, le nombre de sélection doit générer le nombre de lignes correspondantes.
Par exemple, pour VP et Manager cochés, puis Country et Group cochés, on aurait 4 lignes générées:
- VP Country
- VP Group
- Manager Country
- Manager Group.

Merci pour votre aide!

Eve.

bonjour

Tu peux tester cette procdure qui boucle sur les controles des Frames 4 et 5, dans ton 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
Dim x As Integer, y As Integer
Dim i As Integer
 
'recherche la denière ligne non vide dans la feuille "List of reports"
    'Nota:
    'Passez la constante nom_ficher en PUBLIC
i = Worksheets(nom_ficher).Range("N65536").End(xlUp).Row
 
'Boucle sur les contrôles du Frame "Type of User", qui ne contient
'que des checkbox.
For x = 0 To Frame4.Controls.Count - 1
    'Vérifie si la CheckBox est cochée
    If Frame4.Controls.Item(x).Value = True Then
 
        'Boucle sur les contrôles du Frame "Geographical Scope",
        'qui ne contient que des checkbox.
        For y = 0 To Frame5.Controls.Count - 1
            'Vérifie si la CheckBox est cochée
            If Frame5.Controls.Item(y).Value = True Then
 
                i = i + 1
                'Ajoute une donnée dans la colonne N
                Worksheets(nom_ficher).Range("N" & i) = _
                    Frame4.Controls.Item(x).Caption
 
                'Ajoute une donnée dans la colonne L
                Worksheets(nom_ficher).Range("L" & i) = _
                    Frame5.Controls.Item(y).Caption
 
            End If
        Next y
 
    End If
Next x

michel

Bonjour Evema,

Je vous ai adressé le fichier.

-j'ai ajouté 2 devant le nom pour ne pas écraser le vôtre (au cas où). Vous pourrez le renommer ensuite.

-je n'ai pas supprimé les modules1, 2 et 3 car je ne sais pas s'ils vont vous servir.

Voici le code pour le "UserForm1" :

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
Sub CommandButton1_Click()
Unload UserForm1
End Sub
Sub Bt_Valider_Click()
 
ctrlid4 = 0
 
fm4 = Frame4.Controls.Count
fm5 = Frame5.Controls.Count
fm6 = Frame6.Controls.Count
ctrlid4 = 0
nbl = 0
nb4 = 0
nb5 = 0
nb6 = 0
 
text1 = TextBox1
text2 = TextBox2
 
Ftype:
 
        If ctrlid4 >= fm4 Then
        Call Fin_trait
        Unload UserForm1
        End
        End If
        If Frame4.Controls.Item(ctrlid4).Value = False Then
        ctrlid4 = ctrlid4 + 1
        GoTo Ftype
        Else
        lab4 = Frame4.Controls.Item(ctrlid4).Caption
        nb4 = nb4 + 1
        End If
 
If nb4 = 0 Then
MsgBox "Aucune sélection trouvée dans Type of user.", _
              vbOKOnly + vbInformation + vbApplicationModal, "Information"
End If
 
ctrlid5 = 0
 
Fgeographic:
 
        If ctrlid5 >= fm5 Then
        ctrlid4 = ctrlid4 + 1
        GoTo Ftype
        End If
        If Frame5.Controls.Item(ctrlid5).Value = False Then
        ctrlid5 = ctrlid5 + 1
        GoTo Fgeographic
        Else
        lab5 = Frame5.Controls.Item(ctrlid5).Caption
        nb5 = nb5 + 1
        End If
 
If nb5 = 0 Then
MsgBox "Aucune sélection trouvée dans Geographical scope.", _
              vbOKOnly + vbInformation + vbApplicationModal, "Information"
End If
 
ctrlid6 = 0
 
Ffunction:
 
        If ctrlid6 >= fm6 Then
        ctrlid5 = ctrlid5 + 1
        GoTo Fgeographic
        End If
        If Frame6.Controls.Item(ctrlid6).Value = False Then
        ctrlid6 = ctrlid6 + 1
        GoTo Ffunction
        Else
        lab6 = Frame6.Controls.Item(ctrlid6).Caption
        nb6 = nb6 + 1
        ctrlid6 = ctrlid6 + 1
        End If
 
If nb6 = 0 Then
MsgBox "Aucune sélection trouvée dans Function.", _
              vbOKOnly + vbInformation + vbApplicationModal, "Information"
End If
 
Call Copy_lign
GoTo Ffunction
End Sub

Et celui du Module "Dlign_Copy_lign"

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
Option Explicit
 
Public lab4, lab5, lab6, t, text1, text2 As String
Public fm4, fm5, fm6, nb4, nb5, nb6 As Byte
Public mctrl4, mctrl5, mctrl6 As Object
Dim ctrlid4, ctrlid5, ctrlid6, dl, nbl As Integer
 
 
Sub Dern_lign()
Sheets("List of reports").Activate
dl = 3
 
Cherch_dl:
t = Cells(dl, 13)
If t = "" Then
dl = dl - 1
Load UserForm1
UserForm1.Show
Exit Sub
Else
dl = dl + 1
GoTo Cherch_dl
End If
 
End Sub
 
Sub Copy_lign()
Range(Cells(dl, 1), Cells(dl, 18)).Select
    Selection.Copy
    dl = dl + 1
    nbl = nbl + 1
    Range(Cells(dl, 1), Cells(dl, 1)).Select
    ActiveSheet.Paste
Cells(dl, 12) = lab5
Cells(dl, 13) = lab6
Cells(dl, 14) = lab4
Cells(dl, 1) = text1
Cells(dl, 2) = text2
End Sub
 
Sub Fin_trait()
Unload UserForm1
MsgBox "Traitement terminé, " & nbl & " ligne(s) ajoutée(s).", _
              vbOKOnly + vbInformation + vbApplicationModal, "Information"
 
End Sub

Tenez-moi au courant et en cas de problème n'hésitez pas.

12/04/2007, 14h37
evema

Bonjour,

J'ai pu tester le fichier, ça marche bien.

Merci pour votre réponse et votre travail.

cordialement,

Eve.