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

5 réponses

  1.
    yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 588
     
    bonjour, je pense que tu peux utiliser la même technique que celle utilisée ici.
    0
    1. 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
      1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588 > pyrus2047 Messages postés 156 Statut Membre
         
        ne serait-ce pas plus logique de faire un formulaire dans Access?
        0
    2. 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
  2. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 588
     
    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
    1. 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
    2. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588 > 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
    3. 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
    4. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   1 588 > 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
    5. 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
  3. Castours
     
    https://www.cjoint.com/c/IAgsJNpW0lZ
    Bonjour
    Dans ce lien une base adresses
    Donnes une reponse
    merci
    0
    1. 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
  4. Castours
     
    Bonsoir
    Veux tu un lien pour telecharger pack office 2010
    0
    1. 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

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

    Posez votre question
  6. Castours
     
    bonjour
    personnellement j'en ai pas
    0
    1. 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
Quick Access service
alain_1949 -
billmaxime -

4 réponses