Lier mon userform excel a une table access

Résolu
pyrus2047 Messages postés 156 Statut Membre -  
pyrus2047 Messages postés 156 Statut Membre -
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:

5 réponses

Réponse 1 / 5
yg_be Messages postés 24281 Statut Contributeur Ambassadeur 1 584
 
bonjour, je pense que tu peux utiliser la même technique que celle utilisée ici.
0
pyrus2047 Messages postés 156 Statut Membre
 
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
0
yg_be Messages postés 24281 Statut Contributeur 1 584 > pyrus2047 Messages postés 156 Statut Membre
 
ne serait-ce pas plus logique de faire un formulaire dans Access?
0
pyrus2047 Messages postés 156 Statut Membre
 
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
0
Réponse 2 / 5
yg_be Messages postés 24281 Statut Contributeur Ambassadeur 1 584
 
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
0
pyrus2047 Messages postés 156 Statut Membre
 
Boujour merci
oui c'est un bon debut ya un probleme au moment de charger les testbox dans ComboBox1_Change
cordialement
0
yg_be Messages postés 24281 Statut Contributeur 1 584 > pyrus2047 Messages postés 156 Statut Membre
 
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
0
pyrus2047 Messages postés 156 Statut Membre
 
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
0
yg_be Messages postés 24281 Statut Contributeur 1 584 > pyrus2047 Messages postés 156 Statut Membre
 
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
0
pyrus2047 Messages postés 156 Statut Membre
 
Re
super merci beaucoup pour ton ecoute, aide et profetionnalisme
tout fonctione tres bien
c'est resolu
Cordialement
0
Réponse 3 / 5
Castours
 
https://www.cjoint.com/c/IAgsJNpW0lZ
Bonjour
Dans ce lien une base adresses
Donnes une reponse
merci
0
pyrus2047 Messages postés 156 Statut Membre
 
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
0
Réponse 4 / 5
Castours
 
Bonsoir
Veux tu un lien pour telecharger pack office 2010
0
pyrus2047 Messages postés 156 Statut Membre
 
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
0

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

Posez votre question
Réponse 5 / 5
Castours
 
bonjour
personnellement j'en ai pas
0
pyrus2047 Messages postés 156 Statut Membre
 
Re
merci quant meme pour votre interet
Cordialement
0

Discussions similaires

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

10 réponses
Intégrer une table des annexes et des matières sur word
clairon69 -
Jo -

20 réponses