Discussion :

[thomas.corlay]

Bonjour à tous,

Je tente à nouveau de reprendre ce fichier car il ne fonctionne pas correctement.

En effet lorsque je lance mon écran de saisie via le bouton de la page d'accueil, que j'effectue une saisie, l'enregistrement ne se fait pas.
Alors que si je lance l'écran de saisie via la flèche verte dans VB l'enregistrement s'effectue.

Une ame charitable aurait une idée svp?

merciFichier allégé.xlsm

[EricDgn]

Bonjour,

Dans votre code pour Ajouter_Click(), vous avez placé des Cells (qui envoient donc les données dans la feuille active, càd Accueil - ce que vous pouvez voir si vous en supprimez le fond noir) au lieu de mettre des .Cells (avec un point devant le C):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Private Sub Ajouter_Click()     '--- Bouton Ajouter
    '... ...
            With onglet
                .Cells(derniere_ligne + 1, 1) = reference
                .Cells(derniere_ligne + 1, 2) = ComboBox1.Value
    '... ...

Une autre façon de faire:

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
Private Sub Ajouter_Click()     '--- Bouton Ajouter
    Dim onglet As Worksheet
    Dim derniere_ligne As Long
    Dim i As Long
 
    Set onglet = Worksheets("RJ")
    derniere_ligne = onglet.Cells(Rows.Count, 1).End(xlUp).Row
 
    If ComboBox7.Value = "" Then    '--- ComboBox7 = référence
        '--- ajoute une ligne et une référence
        i = derniere_ligne + 1
        If i = 2 Then
            onglet.Cells(i, 1) = 1
        Else
            onglet.Cells(i, 1) = onglet.Cells(i - 1, 1) + 1
        End If
    Else
        '--- se place sur la ligne ayant la référence
        For i = 2 To derniere_ligne
            If onglet.Cells(i, 8) = ComboBox7.Value Then Exit For
        Next i
    End If
    With onglet
        If i > 2 Then
            '--- recopie le formatage effectué en ligne n°2
            .Range("A2:T2").Copy
            Cells(i, 1).PasteSpecial Paste:=xlPasteFormats
            Application.CutCopyMode = False
        End If
        .Cells(i, 2) = ComboBox1.Value
        .Cells(i, 3) = ComboBox2.Value
        .Cells(i, 4) = DateValue(Format(Date, "dd/mm/yyyy"))
        If TextBox11.Value <> "" Then
            .Cells(i, 5) = CDate(TextBox11.Value)
        Else
            .Cells(i, 5) = ""
        End If
        .Cells(i, 6) = Nom.Value
        .Cells(i, 7) = Prenom.Value
        'formule concatenate pour recherche
        .Cells(i, 8).FormulaR1C1 = "=IF(RC[-2]="""","""",IF(RC[1]="""",CONCATENATE(RC[-2],"" / "",RC[-1]),CONCATENATE(RC[-2],"" / "",RC[-1],"" - "",TEXT(RC[1],""jj/mm/aaaa""))))"
        If TextBox2.Value <> "" Then
            .Cells(i, 9) = CDate(TextBox2.Value)
        Else
            .Cells(i, 9) = ""
        End If
        .Cells(i, 10) = TextBox3.Value
        .Cells(i, 11) = TextBox4.Value
        .Cells(i, 12) = ComboBox3.Value
        .Cells(i, 13) = TextBox5.Value
        .Cells(i, 14) = ComboBox4.Value
        If TextBox7.Value <> "" Then
            .Cells(i, 15) = CDate(TextBox7.Value)
        Else
            .Cells(i, 15) = ""
        End If
        'formule calcul date surveillance
        .Cells(i, 16).FormulaR1C1 = "=IF(RC[-1]="""","""",TODAY()-RC[-1])"
        If TextBox12.Value <> "" Then
            .Cells(i, 17) = CDate(TextBox12.Value)
        Else
            .Cells(i, 17) = ""
        End If
        .Cells(i, 18) = ComboBox5.Value
        .Cells(i, 19) = ComboBox6.Value
        .Cells(i, 20) = TextBox6.Value
    End With
 
    Unload UserForm1
    UserForm1.Show
End Sub

Cordialement.

[thomas.corlay]

Un Grand merci EricDgn !!!!

[EricDgn]

Bonjour,

Juste pour signaler que moi aussi j'ai oublié un point: à la ligne 27 dans mon code !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

            .Cells(i, 1).PasteSpecial Paste:=xlPasteFormats

Bonne continuation.

[thomas.corlay]

Alors là je ne vais pas vous en vouloir... hi hi
Par contre je vais peut être abuser mais j'ai un soucis de filtre également dans cette partie du code (alim combo7):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
If derniere_ligne > 1 Then
arr_data = onglet.Range(onglet.Cells(2, 8), onglet.Cells(derniere_ligne, 8))

j'aimerais que dans la combo un tri alpha soit fait mais sans changer l'ordre de la BD

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
If derniere_ligne > 1 Then
arr_data = sortlist(onglet.Range(onglet.Cells(2, 8), onglet.Cells(derniere_ligne, 8)))

J'ai trouvé plein de codes mais je n'arrive pas à adapter à mon fichier

Si vous avez encore un peu de temps???
merci

[EricDgn]

Bonjour,

En fait vous arr_data est un tableau (array) à 2 dimensions, et il n'y a pas de fonction spécifique pour trier un tel tableau. Il faut le faire par du code. Une façon de faire:

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
Private Sub userform_initialize()
    Dim onglet As Worksheet
    Dim derniere_ligne As Long
    Dim arr_data As Variant
    Dim i As Long, j As Long, arr_tmp As Variant
 
    Set onglet = Worksheets("RJ")
    derniere_ligne = onglet.Cells(Rows.Count, 1).End(xlUp).Row
 
    If derniere_ligne > 1 Then
        arr_data = onglet.Range(onglet.Cells(2, 8), onglet.Cells(derniere_ligne, 8))
        '--- triage A-Z
        For i = LBound(arr_data) To UBound(arr_data)
            For j = i + 1 To UBound(arr_data)
                If UCase(arr_data(i, 1)) > UCase(arr_data(j, 1)) Then
                    arr_tmp = arr_data(j, 1)
                    arr_data(j, 1) = arr_data(i, 1)
                    arr_data(i, 1) = arr_tmp
                End If
            Next j
        Next i
        ComboBox7.List = arr_data
    End If
    '... ... ...

Cordialement.