Bonjour
J'ai cette méthode de connection de mon userform excel avec le runtime d'access qui fonctionne tres bien

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
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
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 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
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
Si vous avez une solution
Cordialement