Exporter valeur textbox par selection dans combobox

**loisphil** · 04/04/2019, 20h55

Bonjour forum,

Je reviens vers vous pour compléter mon fichier.
J'ai créé un userform dans lequel je répertorie la fiche des clients (n° de client, nom, adresse etc..) dans un fichier fermé nommé "Fichier Clients" jusque-là tout va bien.

Mon souci c'est que je voudrai par ce même userform utiliser la combobox C1 que j'ai lié avec les N°de client de la feuille "CLIENTS" du classeur fermé "fichier Clients".

En plus simple quand je sélectionne le numéro dans la combobox je voudrai que les données s’affichent dans le userform.
Puis les valider avec le bouton OK pour les coller dans ma feuil "DEVIS" aux cellule correspondante.

J’ai bien essayer de placer un bout de code mais c'est pas du tout ça
mais la ça chauffe trop !!!

La ça deviens trop compliqué pour moi c'est pourquoi je viens chercher de l'aide.

Merci pour votre aide
lias

**mercatog** · 04/04/2019, 21h55

Bonsoir

Ce propose une petite modification dans la conception.

1. Importer les données clients dans une feuille cachée avec xlveryhidden (à supprimer éventuellement après). Cette feuille est créée par code
2. L'importation se fait par adodb (pas besoin d'ouvrir le fichier CLIENTS). PS. Le fichier Clients se trouve dans le même répertoire.
3. Se référer à cette feuille par la suite

Code module standard

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
Option Explicit
 
Function ImportClients() As Boolean
Dim Fichier As String, sSQL As String
Dim Source As Object, Rst As Object
 
Fichier = ThisWorkbook.Path & "\Fichier_Clients.xlsx"
If Dir(Fichier) <> "" Then
    Set Source = CreateObject("ADODB.Connection")
    Source.Open "Provider = Microsoft.ACE.OLEDB.12.0;data source=" & Fichier & ";extended properties=""Excel 12.0;HDR=YES"""
 
    sSQL = "SELECT * FROM [CLIENTS$] ORDER BY [N°client]"
    Set Rst = Source.Execute(sSQL)
    TmpSheet Rst
    Set Rst = Nothing
    Source.Close
    Set Source = Nothing
    ImportClients = True
End If
End Function
 
Private Sub TmpSheet(TheRst As Object)
Dim WsName As String
 
WsName = "wTmp"
If FeuilleExiste(WsName) Then
    ThisWorkbook.Worksheets(WsName).UsedRange.ClearContents
Else
    With ThisWorkbook.Worksheets.Add
        .Visible = xlVeryHidden
        .Name = WsName
    End With
End If
 
ThisWorkbook.Worksheets(WsName).Range("A1").CopyFromRecordset TheRst
End Sub
 
Private Function FeuilleExiste(ByVal Tmp As String) As Boolean
 
On Error Resume Next
FeuilleExiste = ThisWorkbook.Worksheets(Tmp).Index
End Function

Code Userform

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
Option Explicit
 
Private Sub UserForm_Initialize()
Dim N As Long, i As Long
 
If ImportClients Then
    With ThisWorkbook.Worksheets("wTmp")
        N = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 1 To N
            Me.C1.AddItem .Cells(i, 1).Value
        Next i
    End With
End If
End Sub
 
Private Sub C1_Change()
Dim N As Long
 
N = Me.C1.ListIndex + 1
If N > 0 Then
    With ThisWorkbook.Worksheets("wTmp")
        TextBox_N°Client.Value = .Cells(N, 1).Value
        TextBox_Societe.Value = .Cells(N, 3).Value
        TextBox_Adresse.Value = .Cells(N, 4).Value
        TextBox_Ville.Value = .Cells(N, 5).Value
        TextBox_Telephone.Value = .Cells(N, 6).Value
        TextBox_Email.Value = .Cells(N, 7).Value
        Select Case LCase(.Cells(N, 2).Value)
            Case "mme": Me.OptionButton1.Value = True
            Case "mlle": Me.OptionButton2.Value = True
            Case "m", "mr", "m.": Me.OptionButton3.Value = True
        End Select
    End With
End If
End Sub
 
Private Sub OK_Click()
Dim N As Long
 
N = Me.C1.ListIndex + 1
If N > 0 Then
    With Worksheets("DEVIS")
        .Range("H2").Value = Me.TextBox_N°Client.Value
        .Range("F9").Value = Me.TextBox_Societe.Value
        .Range("F10").Value = Me.TextBox_Adresse.Value
        .Range("F11").Value = Me.TextBox_Ville.Value
        .Range("B15").Value = Me.TextBox_Telephone.Value
        .Range("B16").Value = Me.TextBox_Email.Value
        Unload Me
    End With
Else
    MsgBox "Veuillez choisir un client"
End If
End Sub

**loisphil** · 04/04/2019, 22h30

Bonsoir mercatog
Merci pour le code ça fonctionne parfaitement de ce cote la !
mais en revanche mon bouton ajout quand je rentre un nouveau client ça coince !

le user sert aussi a ajouter des clients que je rappel ensuite. Nom : Capture.JPG
Affichages : 396
Taille : 90,5 Ko

**mercatog** · 04/04/2019, 23h13

De la même façon, on peut écrire dans le fichier clients sans l'ouvrir.

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
Private Sub CommandButton_Ajouter_Click()
Dim Num As String, Civilite As String, Nom As String, Adresse As String
Dim Ville As String, Tel As String, Email As String
Dim Fichier As String, sSQL As String
Dim Source As Object, Rst As Object
 
Label_N°Client.ForeColor = RGB(0, 0, 0)     'N°Client
Label_Societe.ForeColor = RGB(0, 0, 0)     'Societe
Label_Adresse.ForeColor = RGB(0, 0, 0)     'Adresse
Label_Ville.ForeColor = RGB(0, 0, 0)     'Ville
Label_Telephone.ForeColor = RGB(0, 0, 0)     'Telephone
Label_Email.ForeColor = RGB(0, 0, 0)     'Email
 
If TextBox_N°Client.Value = "" Then
    Label_N°Client.ForeColor = RGB(255, 0, 0)     'N°Client
ElseIf TextBox_Societe.Value = "" Then
    Label_Societe.ForeColor = RGB(255, 0, 0)     'Societe
ElseIf TextBox_Adresse.Value = "" Then
    Label_Adresse.ForeColor = RGB(255, 0, 0)     'Adresse
ElseIf TextBox_Ville.Value = "" Then
    Label_Ville.ForeColor = RGB(255, 0, 0)     'Ville
ElseIf TextBox_Telephone.Value = "" Then
    Label_Telephone.ForeColor = RGB(255, 0, 0)     'Telephone
ElseIf TextBox_Email.Value = "" Then
    Label_Email.ForeColor = RGB(255, 0, 0)     'Email
Else
    Num = Me.TextBox_N°Client.Value
    If Me.OptionButton1.Value Then
        Civilite = "Mme"
    ElseIf Me.OptionButton2.Value Then
        Civilite = "Mlle"
    Else
        Civilite = "M"
    End If
    Nom = Replace(Me.TextBox_Societe.Value, "'", "''")
    Adresse = Replace(Me.TextBox_Adresse.Value, "'", "''")
    Ville = Replace(Me.TextBox_Ville.Value, "'", "''")
    Tel = Replace(Me.TextBox_Telephone.Value, "'", "''")
    Email = Replace(Me.TextBox_Email.Value, "'", "''")
 
 
    Fichier = ThisWorkbook.Path & "\Fichier_Clients.xlsx"
    If Dir(Fichier) <> "" Then
        Set Source = CreateObject("ADODB.Connection")
        Source.Open "Provider = Microsoft.ACE.OLEDB.12.0;data source=" & Fichier & ";extended properties=""Excel 12.0;HDR=YES;ReadOnly=0;"";"
 
        sSQL = "INSERT INTO [CLIENTS$] VALUES (" & Num & ",'" & Civilite & "','" & Nom & "', '" & Adresse & "'"
        sSQL = sSQL & ",'" & Ville & "','" & Tel & "','" & Email & "')"
 
        Set Rst = CreateObject("ADODB.Recordset")
        Rst.Open sSQL, Source
        Set Rst = Nothing
        Source.Close
        Set Source = Nothing
        MsgBox "Mise à jour avec succès"
        Unload Me
    End If
End If
End Sub

Bien sur ceci ne gère pas les doublons ni la numérotation automatique. On peut, jusqu'au là, ajouter plusieurs numéros identiques.

**loisphil** · 04/04/2019, 23h23

ça beug ici lorsque je clic ajout

Nom : Capture1.JPG
Affichages : 368
Taille : 48,3 Ko

**mercatog** · 04/04/2019, 23h34

Essaie ceci

On peut ajouter une client ou modifier les information d'un client existant

Change l'ensemble du code de ton userform

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
Option Explicit
 
Private Sub UserForm_Initialize()
Dim N As Long, i As Long
 
If ImportClients Then
    With ThisWorkbook.Worksheets("wTmp")
        N = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 1 To N
            Me.C1.AddItem .Cells(i, 1).Value
        Next i
    End With
End If
End Sub
 
Private Sub C1_Change()
Dim N As Long
 
N = Me.C1.ListIndex + 1
If N > 0 Then
    With ThisWorkbook.Worksheets("wTmp")
        TextBox_N°Client.Value = .Cells(N, 1).Value
        TextBox_Societe.Value = .Cells(N, 3).Value
        TextBox_Adresse.Value = .Cells(N, 4).Value
        TextBox_Ville.Value = .Cells(N, 5).Value
        TextBox_Telephone.Value = .Cells(N, 6).Value
        TextBox_Email.Value = .Cells(N, 7).Value
        Select Case LCase(.Cells(N, 2).Value)
            Case "mme": Me.OptionButton1.Value = True
            Case "mlle": Me.OptionButton2.Value = True
            Case "m", "mr", "m.": Me.OptionButton3.Value = True
        End Select
    End With
    Me.CommandButton_Ajouter.Caption = "Modifier"
    Me.TextBox_N°Client.Enabled = False
End If
End Sub
 
Private Sub OK_Click()
Dim N As Long
 
N = Me.C1.ListIndex + 1
If N > 0 Then
    With Worksheets("DEVIS")
        .Range("H2").Value = Me.TextBox_N°Client.Value
        .Range("F9").Value = Me.TextBox_Societe.Value
        .Range("F10").Value = Me.TextBox_Adresse.Value
        .Range("F11").Value = Me.TextBox_Ville.Value
        .Range("B15").Value = Me.TextBox_Telephone.Value
        .Range("B16").Value = Me.TextBox_Email.Value
        Unload Me
    End With
Else
    MsgBox "Veuillez choisir un client"
End If
End Sub
 
Private Sub CommandButton_Ajouter_Click()
Dim Num As String, Civilite As String, Nom As String, Adresse As String
Dim Ville As String, Tel As String, Email As String
Dim Fichier As String, sSQL As String
Dim Source As Object, Rst As Object
Dim Ajout As Boolean
 
Label_N°Client.ForeColor = RGB(0, 0, 0)     'N°Client
Label_Societe.ForeColor = RGB(0, 0, 0)     'Societe
Label_Adresse.ForeColor = RGB(0, 0, 0)     'Adresse
Label_Ville.ForeColor = RGB(0, 0, 0)     'Ville
Label_Telephone.ForeColor = RGB(0, 0, 0)     'Telephone
Label_Email.ForeColor = RGB(0, 0, 0)     'Email
 
If TextBox_N°Client.Value = "" Then
    Label_N°Client.ForeColor = RGB(255, 0, 0)     'N°Client
ElseIf TextBox_Societe.Value = "" Then
    Label_Societe.ForeColor = RGB(255, 0, 0)     'Societe
ElseIf TextBox_Adresse.Value = "" Then
    Label_Adresse.ForeColor = RGB(255, 0, 0)     'Adresse
ElseIf TextBox_Ville.Value = "" Then
    Label_Ville.ForeColor = RGB(255, 0, 0)     'Ville
ElseIf TextBox_Telephone.Value = "" Then
    Label_Telephone.ForeColor = RGB(255, 0, 0)     'Telephone
ElseIf TextBox_Email.Value = "" Then
    Label_Email.ForeColor = RGB(255, 0, 0)     'Email
Else
    Num = Me.TextBox_N°Client.Value
    If Me.OptionButton1.Value Then
        Civilite = "Mme"
    ElseIf Me.OptionButton2.Value Then
        Civilite = "Mlle"
    Else
        Civilite = "M"
    End If
    Nom = UCase(Replace(Me.TextBox_Societe.Value, "'", "''"))
    Adresse = UCase(Replace(Me.TextBox_Adresse.Value, "'", "''"))
    Ville = UCase(Replace(Me.TextBox_Ville.Value, "'", "''"))
    Tel = Replace(Me.TextBox_Telephone.Value, "'", "''")
    Email = LCase(Replace(Me.TextBox_Email.Value, "'", "''"))
 
 
    Fichier = ThisWorkbook.Path & "\Fichier_Clients.xlsx"
    If Dir(Fichier) <> "" Then
        Ajout = Me.CommandButton_Ajouter.Caption <> "Modifier"
        Set Source = CreateObject("ADODB.Connection")
        If Ajout Then
            Source.Open "Provider = Microsoft.ACE.OLEDB.12.0;data source=" & Fichier & ";extended properties=""Excel 12.0;HDR=YES;ReadOnly=0;"";"
 
            sSQL = "INSERT INTO [CLIENTS$] VALUES (" & Num & ",'" & Civilite & "','" & Nom & "', '" & Adresse & "'"
            sSQL = sSQL & ",'" & Ville & "','" & Tel & "','" & Email & "')"
 
 
        Else
            Source.Open "Provider = Microsoft.ACE.OLEDB.12.0;data source=" & Fichier & ";extended properties=""Excel 12.0;HDR=YES;"";"
            sSQL = "UPDATE [CLIENTS$] SET [Civilité]='" & Civilite & "',[Societe/Nom]='" & Nom & "',[Adresse]='" & Adresse & "'"
            sSQL = sSQL & ",[Ville]='" & Ville & "',[TELEPHONE ]='" & Tel & "',[EMAIL]='" & Email & "' WHERE [N°client]='" & Num &"'"
 
        End If
 
            Source.Execute sSQL
        Source.Close
        Set Source = Nothing
        MsgBox "Mise à jour avec succès"
        Unload Me
    End If
End If
End Sub
 
Private Sub CommandButton_Fermer_Click()
 
Unload Me
End Sub

Exporter valeur textbox par selection dans combobox

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager