Mise à jour des données par formulaire vba Excel

Version imprimable

Amis du forum Bonjour:)
Je suis à nouveau dans une impasse, comme tous les débutants, et je manque franchement d'inspiration.
J'ai vraiment besoin d'un lanterne pour ce qui suit :

Je dispose d'une feuil (DB_CLIENTS) qui est alimentée par un formulaire de création nouveau client (FrmClient). Cette première partie fonctionne plutôt bien.

J'ai depuis créé un autre formulaire (ModifClient)sur la même base pour modifier ou supprimer les comptes clients existant
J'alimente ce même formulaire en données par un combobox (CboxIdClient)
Le formulaire affiche correctement les infos dans les zones correspondantes.

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
Private Sub CboxIdClient_Change()
    Dim Rg As Range
    Dim Sh As Worksheet
 
    Set Sh = Worksheets("BD_CLIENTS")
 
    'Recherche l'ID
    Set Rg = Sh.Range("A:A").Find(what:=CboxIdClient.Value, lookat:=xlWhole)
    'Si ID trouvé on alimente les zones du formulaire en données
    If Not Rg Is Nothing Then
        Me.CboxFormesJuridiques.Value = Rg.Offset(0, 1).Value
        Me.ZtxtRaisonSociale.Text = Rg.Offset(0, 2).Value
        Me.CboxCivilite.Value = Rg.Offset(0, 3).Value
        Me.ZtxtNom.Text = Rg.Offset(0, 4).Value
        Me.ZtxtPrenom.Text = Rg.Offset(0, 5).Value
        Me.ZtxtAdresseL1.Text = Rg.Offset(0, 6).Value
        Me.ZtxtAdresseL2.Text = Rg.Offset(0, 7).Value
        Me.ZtxtCodePostal.Text = Rg.Offset(0, 8).Value
        Me.CboxVille.Value = Rg.Offset(0, 9).Value
        Me.ZtxtEmail.Text = Rg.Offset(0, 10).Value
        Me.ZtxtTelephonePrincipal.Text = Rg.Offset(0, 11).Value
        Me.ZtxtTelephoneSecondaire.Text = Rg.Offset(0, 12).Value
    End If
End Sub

Je souhaite maintenant mettre à jours ces nouvelles données dans la feuil(DB_CLIENT) et c'est là que je sèche. Je n'arrive pas à déclarer la ligne de référence pour la valeur de la variable que j'ai nommé (NumLign)

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
Private Sub CmdModifier_Click()
    Dim NumLign As Chart
 
    NumLign = ???????????????  
 
    With Sheets("BD_CLIENTS")
        Range("B" & Val(NumLign)).Value = CboxFormesJuridiques.Value
        Range("C" & Val(NumLign)).Value = ZtxtRaisonSociale.Value
        Range("D" & Val(NumLign)).Value = CboxCivilite.Value
        Range("E" & Val(NumLign)).Value = ZtxtNom.Value
        Range("F" & Val(NumLign)).Value = ZtxtPrenom.Value
        Range("G" & Val(NumLign)).Value = ZtxtAdresseL1.Value
        Range("H" & Val(NumLign)).Value = ZtxtAdresseL2.Value
        Range("I" & Val(NumLign)).Value = ZtxtCodePostal.Value
        Range("J" & Val(NumLign)).Value = CboxVille.Value
        Range("K" & Val(NumLign)).Value = ZtxtEmail.Value
        Range("L" & Val(NumLign)).Value = ZtxtTelephonePrincipal.Value
        Range("M" & Val(NumLign)).Value = ZtxtTelephoneSecondaire.Value
        Range("N" & Val(NumLign)).Value = ZtxtDate.Value
 
    End With
 
    Unload FrmClient
 
    Call ThisWorkbook.TriGamma
    Call ThisWorkbook.AutoSize
 
    Worksheets("Formulaires").Activate
 
    Message = "Les données du client ont bien été Modifiées !"
    Style = vbOKOnly
    Titre = "Opération validée !"
    MsgBox Message, Style, Titre
 
    FrmClient.Show
 
End Sub

Peut-être ne suis-je pas sur la bonne voie. Quelqu'un peut m'aider ?
Merci.

Utilise la méthode Find (comme fait dans le premier code)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Dim Rg As Range
Dim NumLign As Long
 
With Sheets("BD_CLIENTS")
    Set Rg = .Range("A:A").Find(what:=CboxIdClient.Value, LookIn:=xlValues, lookat:=xlWhole)
    If Not Rg Is Nothing Then
        NumLign = Rg.Row
        Set Rg = Nothing
        .Range("B" & NumLign).Value = CboxFormesJuridiques.Value
        .Range("C" & NumLign).Value = ZtxtRaisonSociale.Value
        '...
    End If
End With

EDIT

XlValues à la place de XlValue (désolé pour l'oubli)

re Utilise la méthode Find

Merci mercatog pour cette proposition, j'ai testé et j'ai toutefois un message d'erreur comme celui-ci :

erreur d'exécution '9'

L'indice n'appartient pas à la sélection....

Ce message est rapporté de la ligne :

Code:

Set Rg = .Range("A:A").Find(what:=CboxIdClient.Value, LookIn:=xlValue, lookat:=xlWhole)

J'ai peut être été maladroit en reportant ta proposition comme suit :

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
Private Sub CmdModifier_Click()
    Dim Rg As Range
    Dim NumLign As Long
 
    With Sheets("BD_CLIENTS")
        Set Rg = .Range("A:A").Find(what:=CboxIdClient.Value, LookIn:=xlValue, lookat:=xlWhole)
        If Not Rg Is Nothing Then
            NumLign = Rg.Row
            Set Rg = Nothing
            .Range("B" & NumLign).Value = CboxFormesJuridiques.Value
            .Range("C" & NumLign).Value = ZtxtRaisonSociale.Value
            .Range("D" & NumLign).Value = CboxCivilite.Value
            .Range("E" & NumLign).Value = ZtxtNom.Value
            .Range("F" & NumLign).Value = ZtxtPrenom.Value
            .Range("G" & NumLign).Value = ZtxtAdresseL1.Value
            .Range("H" & NumLign).Value = ZtxtAdresseL2.Value
            .Range("I" & NumLign).Value = ZtxtCodePostal.Value
            .Range("J" & NumLign).Value = CboxVille.Value
            .Range("K" & NumLign).Value = ZtxtEmail.Value
            .Range("L" & NumLign).Value = ZtxtTelephonePrincipal.Value
            .Range("M" & NumLign).Value = ZtxtTelephoneSecondaire.Value
            .Range("N" & NumLign).Value = ZtxtDate.Value
        End If
    End With
 
    Unload ModifClient
 
    Call ThisWorkbook.TriGamma
    Call ThisWorkbook.AutoSize
 
    Worksheets("Formulaires").Activate
 
    Message = "Les données du client ont bien été Modifiées !"
    Style = vbOKOnly
    Titre = "Opération validée !"
    MsgBox Message, Style, Titre
 
    ModifClient.Show
 
End Sub

15/02/2012, 16h19
mercatog

Désolé, une coquille dans le paramètre de Find (je vais éditer le code)

Code:

Lookin:=XlValues
15/02/2012, 16h33
rattus34
Merci du coup de pouce, je n'y serais jamais arrivé seul, avec mes petites connaissances.
Je ne voudrais pas trop abuser mais pour la commande supprimer une ligne, je suis dans la même galère
Code:

1 2 3 Private Sub CmdSupprimer_Click() End Sub
une idée ?

Il faudrait étudier le code et si tu l'avais fais, tu aurais trouvé.
Sur le même principe:

Code:

1
2
3
4
5
6
7
8
9
Private Sub CmdSupprimer_Click()
Dim Rg As Range
 
Set Rg = Worksheets("BD_CLIENTS").Range("A:A").Find(what:=CboxIdClient.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not Rg Is Nothing Then
    Rg.EntireRow.Delete
    Set Rg = Nothing
End If
End Sub

15/02/2012, 16h45
rattus34

C'est vrai, là je dois dire que je suis largué...:oops:
Mais ça vaut un grand merci mercatog :ccool:.

Mes très sincères salutations.
Stéphane.

C'est à nouveau moi, désolé de ré-ouvrir ce post, mais j'ai à nouveau un message d'erreur lorsque je clique sur le bouton Supprimer :

erreur d'exécution '1004'

Erreur définie par l'application ou par l'objet...

Cette erreur renvoi sur la ComboBox CboxIdClient à la ligne suivante :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Private Sub CboxIdClient_Change() Dim Rg As Range Dim Sh As Worksheet Set Sh = Worksheets("BD_CLIENTS") 'Recherche l'ID Set Rg = Sh.Range("A:A").Find(what:=CboxIdClient.Value, lookat:=xlWhole) . . . End Sub
Pour info lors du débogage si je clique sur fin, la ligne se trouve quand même supprimée dans la Feuil BD_CLIENT.

Essaies comme ceci (tester d'abord si ListIndex de ta combo >-1, c'est à dire un item est sélectionné)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Sub CboxIdClient_Change()
Dim Rg As Range
 
If Me.CboxIdClient.ListIndex > -1 Then
    Set Rg = Worksheets("BD_CLIENTS").Range("A:A").Find(what:=Me.CboxIdClient.Value, LookIn:=xlValues, LookAt:=xlWhole)
    'Si ID trouvé on alimente les zones du formulaire en données
    If Not Rg Is Nothing Then
        Me.CboxFormesJuridiques.Value = Rg.Offset(0, 1).Value
        Me.ZtxtRaisonSociale.Text = Rg.Offset(0, 2).Value
        Me.CboxCivilite.Value = Rg.Offset(0, 3).Value
        Me.ZtxtNom.Text = Rg.Offset(0, 4).Value
        Me.ZtxtPrenom.Text = Rg.Offset(0, 5).Value
        Me.ZtxtAdresseL1.Text = Rg.Offset(0, 6).Value
        Me.ZtxtAdresseL2.Text = Rg.Offset(0, 7).Value
        Me.ZtxtCodePostal.Text = Rg.Offset(0, 8).Value
        Me.CboxVille.Value = Rg.Offset(0, 9).Value
        Me.ZtxtEmail.Text = Rg.Offset(0, 10).Value
        Me.ZtxtTelephonePrincipal.Text = Rg.Offset(0, 11).Value
        Me.ZtxtTelephoneSecondaire.Text = Rg.Offset(0, 12).Value
        Set Rg = Nothing
    End If
End If
End Sub

16/02/2012, 00h42
rattus34

1 pièce(s) jointe(s)

Merci d'être de retour, j'ai essayé votre propososition, le problème reste le même. j'avais entrepris à tout hasard le même essai.

Résultat : Même message d'erreur pour la même ligne.

Je prépare une copie allégé (sans données personnelles), ça sera peut être mieux d'avoir une vue d'ensemble.

Peut être qu'a force de rajouter les solutions de chacun, j'ai fini par alourdir l'ensemble avec des maladresses.
(j'ai laissé votre solution en commentaire)

J'ai un peu revu ton code lié au formulaire de modification (tu sauras adapter pour les autres formulaires)

1. Renomme ta plage ID_Clients comme ceci

Code:

=DECALER(BD_CLIENTS!$A$1;1;;NBVAL(BD_CLIENTS!$A:$A)-1)

2. Insère un module public dans ton projet et y mets ce code

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
Option Explicit
 
Public Function ListeDesVilles(ByVal USF As UserForm) As Boolean
Dim Trouve As Range
Dim FirstAddress As String
 
'*********TESTS A FAIRE**********
'* Tester le contenu du TextBox *
'********************************
USF.CboxVille.Clear
With Sheets("BD_VILLES")
    Set Trouve = .Range("A:A").Find(USF.ZtxtCodePostal.Value, LookIn:=xlValues, LookAt:=xlWhole)
    If Trouve Is Nothing Then
        MsgBox "Ce code n'est pas rattaché à aucune commune !", vbExclamation, "Code erroné"
        ListeDesVilles = True
    Else
        FirstAddress = Trouve.Address
        Do
            USF.CboxVille.AddItem .Range("B" & Trouve.Row)
            Set Trouve = .Range("A:A").Cells.FindNext(Trouve)
        Loop While Not Trouve Is Nothing And Trouve.Address <> FirstAddress
        Set Trouve = Nothing
    End If
End With
End Function

3. Code de ton userform de modification

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
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
Option Explicit
'format type des msgbox.
Dim Message As String
Dim Titre As String
Dim Style As Byte
 
Private Sub UserForm_Initialize()
 
'Affecte les listes aux ComboBox
Me.CboxFormesJuridiques.RowSource = "List_!List_FormesJuridiques"
Me.CboxCivilite.RowSource = "List_!List_Civilite"
Me.CboxIdClient.RowSource = "BD_CLIENTS!ID_Clients"
Me.CboxIdClient.ListIndex = -1
'Affecte la date du jour sur ZtxtDate au format dd/mm/yyyy
Me.ZtxtDate.Value = Format(Now(), "dd/mm/yyyy")
 
End Sub
 
Private Sub CboxIdClient_Change()
Dim Rg As Range
 
If Me.CboxIdClient.ListIndex > -1 Then
    'Recherche l'ID
    Set Rg = Worksheets("BD_CLIENTS").Range("A:A").Find(what:=CboxIdClient.Value, LookIn:=xlValues, LookAt:=xlWhole)
    'Si ID trouvé on alimente les zones du formulaire en données
    If Not Rg Is Nothing Then
        Me.CboxFormesJuridiques.Value = Rg.Offset(0, 1).Value
        Me.ZtxtRaisonSociale.Text = Rg.Offset(0, 2).Value
        Me.CboxCivilite.Value = Rg.Offset(0, 3).Value
        Me.ZtxtNom.Text = Rg.Offset(0, 4).Value
        Me.ZtxtPrenom.Text = Rg.Offset(0, 5).Value
        Me.ZtxtAdresseL1.Text = Rg.Offset(0, 6).Value
        Me.ZtxtAdresseL2.Text = Rg.Offset(0, 7).Value
        Me.ZtxtCodePostal.Text = Rg.Offset(0, 8).Value
        Me.CboxVille.Value = Rg.Offset(0, 9).Value
        Me.ZtxtEmail.Text = Rg.Offset(0, 10).Value
        Me.ZtxtTelephonePrincipal.Text = Rg.Offset(0, 11).Value
        Me.ZtxtTelephoneSecondaire.Text = Rg.Offset(0, 12).Value
        Set Rg = Nothing
    End If
Else
    Initialiser
End If
End Sub
 
Private Sub Initialiser()
Dim Ctl As Object
 
For Each Ctl In Me.Controls
    If TypeOf Ctl Is MSForms.TextBox Then
        Ctl.Value = ""
    ElseIf TypeOf Ctl Is MSForms.ComboBox Then
        Ctl.ListIndex = -1
    End If
Next Ctl
End Sub
 
Private Sub ZtxtCodePostal_Exit(ByVal Cancel As MSForms.ReturnBoolean)
 
Cancel = ListeDesVilles(Me)
End Sub
 
Private Sub CmdModifier_Click()
Dim NumLign As Long
Dim Rg As Range
 
With Sheets("BD_CLIENTS")
    Set Rg = .Range("A:A").Find(what:=CboxIdClient.Value, LookIn:=xlValues, LookAt:=xlWhole)
    If Not Rg Is Nothing Then
        NumLign = Rg.Row
        Set Rg = Nothing
        .Range("B" & NumLign).Value = CboxFormesJuridiques.Value
        .Range("C" & NumLign).Value = ZtxtRaisonSociale.Value
        .Range("D" & NumLign).Value = CboxCivilite.Value
        .Range("E" & NumLign).Value = ZtxtNom.Value
        .Range("F" & NumLign).Value = ZtxtPrenom.Value
        .Range("G" & NumLign).Value = ZtxtAdresseL1.Value
        .Range("H" & NumLign).Value = ZtxtAdresseL2.Value
        .Range("I" & NumLign).Value = ZtxtCodePostal.Value
        .Range("J" & NumLign).Value = CboxVille.Value
        .Range("K" & NumLign).Value = ZtxtEmail.Value
        .Range("L" & NumLign).Value = ZtxtTelephonePrincipal.Value
        .Range("M" & NumLign).Value = ZtxtTelephoneSecondaire.Value
        .Range("N" & NumLign).Value = ZtxtDate.Value
    End If
End With
 
Call ThisWorkbook.AutoSize
Message = "Les données du client n°" & CboxIdClient & " ont bien été Modifiées !"
Style = vbOKOnly
Titre = "Opération validée !"
MsgBox Message, Style, Titre
End Sub
 
Private Sub CmdSupprimer_Click()
Dim Rg As Range
 
Set Rg = Worksheets("BD_CLIENTS").Range("A:A").Find(what:=Me.CboxIdClient.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not Rg Is Nothing Then
    Initialiser
    Rg.EntireRow.Delete
    Set Rg = Nothing
End If
 
Message = "Les données du client n°" & CboxIdClient & " ont bien été supprimée !"
Style = vbOKOnly
Titre = "Opération validée !"
MsgBox Message, Style, Titre
 
End Sub
 
Private Sub CmdAnnuler_Click()
 
Worksheets("Formulaires").Activate
Unload ModifClient
End Sub

Remarques:
Il faudrait revoir les sub mis dans le module ThisWrkbook et je me demande pourquoi tu ne les as pas mis dans un module public. Et au lieu de les appeler par exemple ThisWorkbook.Autosize, il suffirait de Call Autosize et même ce nom portera à confusion.

Évites les Select et travailles directement (je donnerai un exemple et tu adapteras au autres)
Ton code

Code:

1
2
3
4
5
6
7
8
9
10
11
Sub TriBeta()
 
' TriBeta Macro
 
Range("A2").Select
Range("BD_FOURNISSEURS!A2:N65536").Select
 
'Range(ActiveCell, ActiveCell.End(xlDown)).Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range("B2"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
 
End Sub

Ce qu'il fallait faire

Code:

1
2
3
4
5
6
7
8
Sub TriBeta()
Dim LastLig As Long
 
With ThisWorkbook.Worksheets("BD_FOURNISSEURS")
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row    'Dernière ligne remplie de la colonne A de la feuille BD_FOURNISSEURS
    .Range("A2:N" & LastLig).Sort Key1:=.Range("B2"), Order1:=xlAscending, Header:=xlNo
End With
End Sub

Tu remarqueras que je n'ai rien sélectionné et à Chaque Range ou Cells, je les préfixés par la feuille à laquelle ils appartiennent.

Peut être trop de remarques. je m'arrête ici.

16/02/2012, 12h42
rattus34

Que dire d'autre sinon Merci !
C'est une bonne chose, puisque je vais repartir sur de bonnes bases et grace à vos commentaires, m'enrichir d'un peu plus de connaissances.

Il est évident qu'a mon niveau je ne comprends pas tout encore, mais très sincèrement : Un grand MERCI mercatog:ccool:
16/02/2012, 12h48
mercatog

Il faudrait absolument retravailler les autres codes.
Sinon, je vous dis bravo pour la conception. :ccool: