Bonjour
J'ai cette méthode de connection de mon userform excel avec le runtime d'access qui fonctionne tres bien
Je souhaite l'adapter a ces deux bout de code
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 'connection base et recherche Sub Connecte_base_Access() Dim rs As Object Dim Nom_Base, Chemin_Base, Sql, PAPA, Admin, Uid, pwd, ExtendedAnsiSQL ', connstring Set conn = CreateObject("ADODB.Connection") ' Nom_Base = "ListView table.accdb" ' Chemin_Base = ThisWorkbook.Path & "\" & Nom_Base Chemin_Base = "C:\Users\Arnaud\Documents\table.accdb" connstring = "DRIVER={Microsoft Access Driver (*.mdb, *.accdb)}; DBQ=" & Chemin_Base & ";Uid=Admin;Pwd=PAPA;ExtendedAnsiSQL=1;" conn.Open connstring End Sub Private Sub Ajouter_Click() If TextBox3 <> "" Then Set rs = CreateObject("ADODB.recordset") Sql = "select * from [MES MAGASIN]" rs.Open Sql, conn, 3, 3 If Not rs.EOF And Not rs.BOF Then rs.AddNew rs.Fields(1) = TextBox3 rs.Fields(2) = TextBox4 rs.Fields(3) = TextBox5 rs.Fields(4) = TextBox6 rs.Fields(5) = TextBox7 rs.Fields(6) = TextBox8 rs.Fields(7) = TextBox9 rs.Fields(8) = TextBox10 rs.Fields(9) = TextBox11 rs.Fields(10) = TextBox12 rs.Update End If rs.Close Set rs = Nothing ListView1.ListItems.Clear Flg_Boutons = True Call Recherche_Infos_Affichage_LVW Flg_Boutons = False End If MsgBox "Attention: votre enregistrement est Ajouter!!" End Sub
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
131
132
133
134
135
136
137
138
139 Option Explicit Const c_t_parm As String = "Tombins" Dim ACapp As Access.Application, db As DAO.Database, rcontacts As DAO.Recordset Private Sub CommandButton4_Click() If Me.ComboBox1.Value = "" Then MsgBox "veuillez sélectionner une donnée dans la liste déroulante" Else rcontacts.FindFirst ("[NOM PRENOM]='" & Me.ComboBox1.Value & "'") rcontacts.Edit rcontacts![NOM PRENOM] = Me.TextBox1.Value rcontacts!MAIL = Me.TextBox2.Value rcontacts!TELEPHONE = Me.TextBox3.Value rcontacts!ADRESSE = Me.TextBox4.Value If Me.CheckBox1 = True Then rcontacts!PHOTOS = "oui" Else rcontacts!PHOTOS = "NON" End If rcontacts.Update End If Me.TextBox1 = "" Me.TextBox2 = "" Me.TextBox3 = "" Me.TextBox4 = "" Me.CheckBox1 = False MsgBox "Votre enregistrement a ete modifier" End Sub Private Sub CommandButton1_Click() If MsgBox("Validez vous ces données?", vbYesNo, "Validation") = vbYes Then rcontacts.AddNew rcontacts![NOM PRENOM] = Me.TextBox1.Value rcontacts!MAIL = Me.TextBox2.Value rcontacts!TELEPHONE = Me.TextBox3.Value rcontacts!ADRESSE = Me.TextBox4.Value If Me.CheckBox1 = True Then rcontacts!PHOTOS = "oui" Else rcontacts!PHOTOS = "NON" End If rcontacts.Update End If Me.TextBox1 = "" Me.TextBox2 = "" Me.TextBox3 = "" Me.TextBox4 = "" Me.CheckBox1 = False End Sub Private Sub CommandButton5_Click() rcontacts.FindFirst ("[NOM PRENOM]='" & Me.TextBox1.Value & "'") rcontacts.MovePrevious On Error Resume Next If Not rcontacts.BOF Then Me.TextBox1.Text = rcontacts![NOM PRENOM] Me.TextBox2.Text = rcontacts![Mot de Passe] Me.TextBox3.Text = rcontacts![Contract] Me.TextBox4.Text = rcontacts!MAIL Me.TextBox5.Text = rcontacts!TELEPHONE Me.TextBox6.Text = rcontacts!ADRESSE If rcontacts!PHOTOS = "oui" Then Me.CheckBox1 = True Else Me.CheckBox1 = False End If Else MsgBox "Vous êtes au premier enregistrement" End If End Sub Private Sub CommandButton6_Click() rcontacts.FindFirst ("[NOM PRENOM]='" & Me.TextBox1.Value & "'") rcontacts.MoveNext On Error Resume Next If Not rcontacts.EOF Then Me.TextBox1.Text = rcontacts![NOM PRENOM] Me.TextBox2.Text = rcontacts![Mot de Passe] Me.TextBox3.Text = rcontacts![Contract] Me.TextBox4.Text = rcontacts!MAIL Me.TextBox5.Text = rcontacts!TELEPHONE Me.TextBox6.Text = rcontacts!ADRESSE If rcontacts!PHOTOS = "oui" Then Me.CheckBox1 = True Else Me.CheckBox1 = False End If Else MsgBox "Vous êtes au dernier enregistrement" End If End Sub Private Sub ComboBox1_Change() Dim photo As String On Error Resume Next rcontacts.FindFirst ("[NOM PRENOM]='" & Me.ComboBox1.Value & "'") Me.TextBox1.Text = rcontacts![NOM PRENOM] Me.TextBox2.Text = rcontacts![Mot de Passe] Me.TextBox3.Text = rcontacts![Contract] Me.TextBox4.Text = rcontacts!MAIL Me.TextBox5.Text = rcontacts!TELEPHONE Me.TextBox6.Text = rcontacts!ADRESSE If rcontacts!PHOTOS = "oui" Then Me.CheckBox1 = True Else Me.CheckBox1 = False End If On Error GoTo defaut photo = TextBox1.Value Image1.Picture = LoadPicture("C:\Users\Arnaud\Pictures\organe\" & photo & ".jpg") Exit Sub defaut: Image1.Picture = LoadPicture("C:\Users\Arnaud\Pictures\organe\Defaut.jpg") End Sub Private Sub CommandButton2_Click() Unload Me End Sub Private Sub Textbox1_Change() Dim photo As String On Error GoTo defaut photo = TextBox1.Value Image1.Picture = LoadPicture("C:\Users\Arnaud\Pictures\organe\" & photo & ".jpg") Exit Sub defaut: Image1.Picture = LoadPicture("C:\Users\Arnaud\Pictures\organe\Defaut.jpg") End Sub Private Sub UserForm_Initialize() Set ACapp = New Access.Application Set db = ACapp.DBEngine.OpenDatabase _ ("C:\Users\Arnaud\Documents\table.accdb", False, False, ";pwd=PAPA") Set rcontacts = db.OpenRecordset(c_t_parm, dbOpenDynaset) Do While Not rcontacts.EOF ComboBox1.AddItem rcontacts![NOM PRENOM] rcontacts.MoveNext Loop End SubSi vous avez une solution
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 Function fMDP(Utilisateur As String, MdP As String) As Boolean Dim ACapp As Access.Application, db As DAO.Database, rTrouve As DAO.Recordset, Sql As String Dim ws As Worksheet, fd As DAO.Field 'On Error Resume Next Set ACapp = New Access.Application Set db = DBEngine.OpenDatabase("C:\Users\Arnaud\Documents\table.accdb", False, False, ";pwd=PAPA") Sql = "select * from Tombins where [NOM PRENOM]='" & Utilisateur & "' and [Mot de Passe] ='" & MdP & "'" Set rTrouve = db.OpenRecordset(Sql) If rTrouve.EOF Then fMDP = False Else fMDP = True For Each ws In ThisWorkbook.Sheets For Each fd In rTrouve.Fields If ws.Name = fd.Name Then If fd.Value = "X" Then ws.Visible = True Else ws.Visible = xlSheetVeryHidden End If Exit For End If Next fd Next ws End If db.Close ActiveWindow.DisplayWorkbookTabs = False End Function
Cordialement
Partager