Bonjour, j' ai un fichier excel qui me permet de gere mes contact depuis un userform qui a pour base la feuil 1 que je souhaite remplacer par une table pour que mon userform recupere , ajoute , modifie , et supprime les informations dans la table access voici les ficher access et excel https://www.cjoint.com/c/HLzmhzOzg1l Cordialement Configuration: Windows / Chrome 71.0.3578.98

Lier mon userform excel a une table access [Résolu]

Réponse 1 / 5

yg_be Messages postés 22724 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476
25 déc. 2018 à 14:12

bonjour, je pense que tu peux utiliser la même technique que celle utilisée ici.

pyrus2047 Messages postés 154 Date d'inscription lundi 3 juillet 2017 Statut Membre Dernière intervention 22 mai 2023
25 déc. 2018 à 15:00

RE
merci pour ton aide precieuse
oui mais je ne sais comment adapter la fonction
pour qu'elle recherche , ajoute , modifie ,supprime
si tu a une solution
Cordialement

yg_be Messages postés 22724 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476 > pyrus2047 Messages postés 154 Date d'inscription lundi 3 juillet 2017 Statut Membre Dernière intervention 22 mai 2023
25 déc. 2018 à 16:55

ne serait-ce pas plus logique de faire un formulaire dans Access?

pyrus2047 Messages postés 154 Date d'inscription lundi 3 juillet 2017 Statut Membre Dernière intervention 22 mai 2023
25 déc. 2018 à 17:23

Re
oui mais chez moi on travail avec excel et pour ne pas pertuber les habitude
je souhaite que le changement ne perturbe les autre utilisateur
Cordialement

Réponse 2 / 5

yg_be Messages postés 22724 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476
25 déc. 2018 à 22:36

suggestion partielle:

Option Explicit
Const c_t_contacts As String = "Contact"
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
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
Range("a2").Select
Me.TextBox1 = ""
Me.TextBox2 = ""
End Sub
Private Sub CommandButton5_Click()
Dim CurrentRow As Long
CurrentRow = CurrentRow - 1
If CurrentRow > 1 Then
TextBox1.Text = Cells(CurrentRow, 1).Value
TextBox2.Text = Cells(CurrentRow, 2).Value
TextBox3.Text = Cells(CurrentRow, 3).Value
TextBox4.Text = Cells(CurrentRow, 4).Value
    If Cells(CurrentRow, 5).Value = "oui" Then
            Me.CheckBox1 = True
            Else
            Me.CheckBox1 = False
    End If
ElseIf CurrentRow = 1 Then
CurrentRow = CurrentRow + 1
MsgBox "Vous êtes au premier enregistrement"
End If
End Sub

Private Sub CommandButton6_Click()
Dim lr As Integer, CurrentRow As Long
lr = Sheets(1).Range("A1000").End(xlUp).Row
CurrentRow = CurrentRow + 1

    If CurrentRow = lr + 1 Then
        CurrentRow = lr
        MsgBox "vous êtes au dernier enregistrement"
    End If
    TextBox1.Text = Cells(CurrentRow, 1).Value
    TextBox2.Text = Cells(CurrentRow, 2).Value
    TextBox3.Text = Cells(CurrentRow, 3).Value
    TextBox4.Text = Cells(CurrentRow, 4).Value
    If Cells(CurrentRow, 5).Value = "oui" Then
            Me.CheckBox1 = True
            Else
            Me.CheckBox1 = False
    End If
End Sub
Private Sub ComboBox1_Change()
Dim photo As String, i As Integer
i = Me.ComboBox1.ListIndex + 2
Me.TextBox1.Text = Cells(i, 1).Value
Me.TextBox2.Text = Cells(i, 2).Value
Me.TextBox3.Text = Cells(i, 3).Value
Me.TextBox4.Text = Cells(i, 4).Value
On Error GoTo defaut
photo = ComboBox1.Value
Image1.Picture = LoadPicture("C:\Users\Pictures\" & photo & ".jpg")
Exit Sub
defaut:
Image1.Picture = LoadPicture("C:\Users\Pictures\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\Pictures\" & photo & ".jpg")
Exit Sub

defaut:
Image1.Picture = LoadPicture("C:\Users\Pictures\Defaut.jpg")
End Sub

Private Sub UserForm_Initialize()

Set ACapp = New Access.Application
Set db = ACapp.DBEngine.OpenDatabase _
    (ThisWorkbook.Path & "\" & "contactes.accdb", , True)
Set rcontacts = db.OpenRecordset(c_t_contacts)
Do While Not rcontacts.EOF
    ComboBox1.AddItem rcontacts![NOM PRENOM] 'Sheets("Feuil1").Cells(i, 1)
    rcontacts.MoveNext
Loop
End Sub

pyrus2047 Messages postés 154 Date d'inscription lundi 3 juillet 2017 Statut Membre Dernière intervention 22 mai 2023
26 déc. 2018 à 08:20

Boujour merci
oui c'est un bon debut ya un probleme au moment de charger les testbox dans ComboBox1_Change
cordialement

yg_be Messages postés 22724 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476 > pyrus2047 Messages postés 154 Date d'inscription lundi 3 juillet 2017 Statut Membre Dernière intervention 22 mai 2023
26 déc. 2018 à 10:32

et ainsi?

Option Explicit
Const c_t_contacts As String = "Contact"
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
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
Range("a2").Select
Me.TextBox1 = ""
Me.TextBox2 = ""
End Sub
Private Sub CommandButton5_Click()
Dim CurrentRow As Long
CurrentRow = CurrentRow - 1
If CurrentRow > 1 Then
TextBox1.Text = Cells(CurrentRow, 1).Value
TextBox2.Text = Cells(CurrentRow, 2).Value
TextBox3.Text = Cells(CurrentRow, 3).Value
TextBox4.Text = Cells(CurrentRow, 4).Value
    If Cells(CurrentRow, 5).Value = "oui" Then
            Me.CheckBox1 = True
            Else
            Me.CheckBox1 = False
    End If
ElseIf CurrentRow = 1 Then
CurrentRow = CurrentRow + 1
MsgBox "Vous êtes au premier enregistrement"
End If
End Sub

Private Sub CommandButton6_Click()
Dim lr As Integer, CurrentRow As Long
lr = Sheets(1).Range("A1000").End(xlUp).Row
CurrentRow = CurrentRow + 1

    If CurrentRow = lr + 1 Then
        CurrentRow = lr
        MsgBox "vous êtes au dernier enregistrement"
    End If
    TextBox1.Text = Cells(CurrentRow, 1).Value
    TextBox2.Text = Cells(CurrentRow, 2).Value
    TextBox3.Text = Cells(CurrentRow, 3).Value
    TextBox4.Text = Cells(CurrentRow, 4).Value
    If Cells(CurrentRow, 5).Value = "oui" Then
            Me.CheckBox1 = True
            Else
            Me.CheckBox1 = False
    End If
End Sub
Private Sub ComboBox1_Change()
rcontacts.FindFirst ("[NOM PRENOM]='" & Me.ComboBox1.Value & "'")
Me.TextBox1.Text = rcontacts![NOM PRENOM]
Me.TextBox2.Text = rcontacts!MAIL
Me.TextBox3.Text = rcontacts!TELEPHONE
Me.TextBox4.Text = rcontacts!ADRESSE
On Error GoTo defaut
Image1.Picture = LoadPicture("C:\Users\Pictures\" & Me.ComboBox1.Value & ".jpg")
Exit Sub
defaut:
Image1.Picture = LoadPicture("C:\Users\Pictures\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\Pictures\" & photo & ".jpg")
Exit Sub

defaut:
Image1.Picture = LoadPicture("C:\Users\Pictures\Defaut.jpg")
End Sub

Private Sub UserForm_Initialize()

Set ACapp = New Access.Application
Set db = ACapp.DBEngine.OpenDatabase _
    (ThisWorkbook.Path & "\" & "contactes.accdb", , True)
Set rcontacts = db.OpenRecordset(c_t_contacts, dbOpenDynaset)
Do While Not rcontacts.EOF
    ComboBox1.AddItem rcontacts![NOM PRENOM] 'Sheets("Feuil1").Cells(i, 1)
    rcontacts.MoveNext
Loop
End Sub

pyrus2047 Messages postés 154 Date d'inscription lundi 3 juillet 2017 Statut Membre Dernière intervention 22 mai 2023
Modifié le 26 déc. 2018 à 12:08

Re
super merci beaucoup
pour finir j'ai encore le souci dans les parties
pour faire defiler les enregistrements

Private Sub CommandButton5_Click()
et
Private Sub CommandButton6_Click()
Cordialement

yg_be Messages postés 22724 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476 > pyrus2047 Messages postés 154 Date d'inscription lundi 3 juillet 2017 Statut Membre Dernière intervention 22 mai 2023
26 déc. 2018 à 12:41

ainsi?

Option Explicit
Const c_t_contacts As String = "Contact"
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
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
Range("a2").Select
Me.TextBox1 = ""
Me.TextBox2 = ""
End Sub
Private Sub CommandButton5_Click()
rcontacts.FindFirst ("[NOM PRENOM]='" & Me.TextBox1.Value & "'")
rcontacts.MovePrevious
If Not rcontacts.BOF Then
    Me.TextBox1.Text = rcontacts![NOM PRENOM]
    Me.TextBox2.Text = rcontacts!MAIL
    Me.TextBox3.Text = rcontacts!TELEPHONE
    Me.TextBox4.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
If Not rcontacts.EOF Then
    Me.TextBox1.Text = rcontacts![NOM PRENOM]
    Me.TextBox2.Text = rcontacts!MAIL
    Me.TextBox3.Text = rcontacts!TELEPHONE
    Me.TextBox4.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()
rcontacts.FindFirst ("[NOM PRENOM]='" & Me.ComboBox1.Value & "'")
Me.TextBox1.Text = rcontacts![NOM PRENOM]
Me.TextBox2.Text = rcontacts!MAIL
Me.TextBox3.Text = rcontacts!TELEPHONE
Me.TextBox4.Text = rcontacts!ADRESSE
On Error GoTo defaut
Image1.Picture = LoadPicture("C:\Users\Pictures\" & Me.ComboBox1.Value & ".jpg")
Exit Sub
defaut:
Image1.Picture = LoadPicture("C:\Users\Pictures\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\Pictures\" & photo & ".jpg")
Exit Sub

defaut:
Image1.Picture = LoadPicture("C:\Users\Pictures\Defaut.jpg")
End Sub

Private Sub UserForm_Initialize()

Set ACapp = New Access.Application
Set db = ACapp.DBEngine.OpenDatabase _
    (ThisWorkbook.Path & "\" & "contactes.accdb", , True)
Set rcontacts = db.OpenRecordset(c_t_contacts, dbOpenDynaset)
Do While Not rcontacts.EOF
    ComboBox1.AddItem rcontacts![NOM PRENOM] 'Sheets("Feuil1").Cells(i, 1)
    rcontacts.MoveNext
Loop
End Sub

pyrus2047 Messages postés 154 Date d'inscription lundi 3 juillet 2017 Statut Membre Dernière intervention 22 mai 2023
26 déc. 2018 à 13:19

Re
super merci beaucoup pour ton ecoute, aide et profetionnalisme
tout fonctione tres bien
c'est resolu
Cordialement

Réponse 3 / 5

Castours
6 janv. 2019 à 19:37

https://www.cjoint.com/c/IAgsJNpW0lZ
Bonjour
Dans ce lien une base adresses
Donnes une reponse
merci

pyrus2047 Messages postés 154 Date d'inscription lundi 3 juillet 2017 Statut Membre Dernière intervention 22 mai 2023
6 janv. 2019 à 22:51

merci pour la prposition mais mon projet comporte un fichier excel
lier a une base access
mon problemme que la solution actuel ne fonctionne pas sur les machines
qui ne dispose que du runtime access
si vous avez une solution
Cordialement

Réponse 4 / 5

Castours
7 janv. 2019 à 00:30

Bonsoir
Veux tu un lien pour telecharger pack office 2010

pyrus2047 Messages postés 154 Date d'inscription lundi 3 juillet 2017 Statut Membre Dernière intervention 22 mai 2023
7 janv. 2019 à 13:49

Bonjour
Nom merci
Je souhait adapter mon code vba-excel lier avec
Un fichier access pour qu'il fonctionne aussi sur les machines qui ne disposent pas d'access mais mais juste du runtime d'access
Si vous avez une solution
Cordialement

Réponse 5 / 5

Castours
15 janv. 2019 à 10:17

bonjour
personnellement j'en ai pas

pyrus2047 Messages postés 154 Date d'inscription lundi 3 juillet 2017 Statut Membre Dernière intervention 22 mai 2023
15 janv. 2019 à 10:21

Re
merci quant meme pour votre interet
Cordialement

Lier mon userform excel a une table access

5 réponses

Discussions similaires

Newsletters