Lier mon userform excel a une table access

Résolu/Fermé

pyrus2047 Messages postés 153 Date d'inscription lundi 3 juillet 2017 Statut Membre Dernière intervention 22 mai 2023 - Modifié le 25 déc. 2018 à 13:24
pyrus2047 Messages postés 153 Date d'inscription lundi 3 juillet 2017 Statut Membre Dernière intervention 22 mai 2023 - 15 janv. 2019 à 10:21

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

A voir également:

Lier mon userform excel a une table access
Table ascii - Guide
Table des matières word - Guide
Liste déroulante excel - Guide
Déplacer une colonne excel - Guide
Aller à la ligne excel - Guide

5 réponses

Réponse 1 / 5

yg_be Messages postés 23525 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 13 avril 2025 Ambassadeur 1 577
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 153 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 23525 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 13 avril 2025 1 577 > pyrus2047 Messages postés 153 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 153 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 23525 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 13 avril 2025 Ambassadeur 1 577
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 153 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

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 153 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

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 153 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 153 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 153 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

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 5

Castours
15 janv. 2019 à 10:17

bonjour
personnellement j'en ai pas

pyrus2047 Messages postés 153 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

Discussions similaires

Table des matières dont les titres n'apparaissent pas..

Bonjour,

Je suis absolument désespérée et après maintes et maintes lectures et recherches, qu'elles soient sur ce forum ou sur des dizaines d'autres, je me décide enfin à chercher de l'aide ici.

Voici la situation: j'ai un travail d'informatique paaas si compliqué à rendre dans le cadre de ma licence à l'université et je suis parvenue à respecter toutes les consignes sauf celle de la table des matières.

En effet, j'ai attribué les styles 1 et 2 à mes titres mais ces derniers n'apparaissent pas dans la table des matières. J'ai tout essayé... Au final je suis même parvenue à faire apparaître absolument TOUT dans ma table des matières, corps de ...

Intégrer une table des annexes et des matières sur word

Bonsoir,

Je souhaiterais intégrer dans un même doc word une table des matières et une table des annexes. Cela est-il possible et comment?
Merci pour vos réponsesConfiguration: Windows XP
Internet Explorer 7.0