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

Messages postés
125
Date d'inscription
lundi 3 juillet 2017
Statut
Membre
Dernière intervention
24 août 2019
-
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
Afficher la suite 

5 réponses

Messages postés
8742
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
19 octobre 2019
436
0
Merci
bonjour, je pense que tu peux utiliser la même technique que celle utilisée ici.
pyrus2047
Messages postés
125
Date d'inscription
lundi 3 juillet 2017
Statut
Membre
Dernière intervention
24 août 2019
-
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
8742
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
19 octobre 2019
436 > pyrus2047
Messages postés
125
Date d'inscription
lundi 3 juillet 2017
Statut
Membre
Dernière intervention
24 août 2019
-
ne serait-ce pas plus logique de faire un formulaire dans Access?
pyrus2047
Messages postés
125
Date d'inscription
lundi 3 juillet 2017
Statut
Membre
Dernière intervention
24 août 2019
-
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
Commenter la réponse de yg_be
Messages postés
8742
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
19 octobre 2019
436
0
Merci
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

yg_be
Messages postés
8742
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
19 octobre 2019
436 > pyrus2047
Messages postés
125
Date d'inscription
lundi 3 juillet 2017
Statut
Membre
Dernière intervention
24 août 2019
-
je pense que la solution choisie a besoin d'Access, pas simplement du Runtime.
pyrus2047
Messages postés
125
Date d'inscription
lundi 3 juillet 2017
Statut
Membre
Dernière intervention
24 août 2019
-
Oui mais j'ai besoin d'une solution qui fonctionne aussi avec le runtime pour les machine
qui n'on pas access
Cordialement
yg_be
Messages postés
8742
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
19 octobre 2019
436 > pyrus2047
Messages postés
125
Date d'inscription
lundi 3 juillet 2017
Statut
Membre
Dernière intervention
24 août 2019
-
dommage que tu ne l'aies pas signalé au départ.
pyrus2047
Messages postés
125
Date d'inscription
lundi 3 juillet 2017
Statut
Membre
Dernière intervention
24 août 2019
-
desoler je n'avais pas prevu le cas de machine qui ne dispose pas du pack office commplet
Cordialement
pyrus2047
Messages postés
125
Date d'inscription
lundi 3 juillet 2017
Statut
Membre
Dernière intervention
24 août 2019
-
Bonjour
J'ai cette connection dans un userform qui fonctionne en liaison excel avec access et runtime access
si vous avez une solution pour l' adapter a votre version
Cordialement

Option Explicit
Dim conn As Object
Dim connstring
Dim rs As Object
Dim sql
Dim NbRecord
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")
Chemin_Base = "C:\Users\pyrus2047\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 Supprimer_Click()
If TextBox3 <> "" Then
Set rs = CreateObject("ADODB.Recordset")
sql = "select * from [CONTACT] where ID=" & CLng(TextBox2) & ";"
rs.Open sql, conn, 3, 3
If Not rs.EOF And Not rs.BOF Then
rs.Delete
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 Supprimer!!"
End Sub
Commenter la réponse de yg_be
0
Merci
https://www.cjoint.com/c/IAgsJNpW0lZ
Bonjour
Dans ce lien une base adresses
Donnes une reponse
merci
pyrus2047
Messages postés
125
Date d'inscription
lundi 3 juillet 2017
Statut
Membre
Dernière intervention
24 août 2019
-
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
Commenter la réponse de Castours
0
Merci
Bonsoir
Veux tu un lien pour telecharger pack office 2010
pyrus2047
Messages postés
125
Date d'inscription
lundi 3 juillet 2017
Statut
Membre
Dernière intervention
24 août 2019
-
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
Commenter la réponse de Castours
0
Merci
bonjour
personnellement j'en ai pas
pyrus2047
Messages postés
125
Date d'inscription
lundi 3 juillet 2017
Statut
Membre
Dernière intervention
24 août 2019
-
Re
merci quant meme pour votre interet
Cordialement
Commenter la réponse de Castours