Comment liée un userform avec une table access

Résolu

pyrus2047 Messages postés 156 Statut Membre -
pyrus2047 Messages postés 156 Statut Membre - 16 janv. 2019 à 11:08

Bonjour a tous
Dans l' userform 1 j' ai une listview qui colore sus condition les lignes et champ de recherche multicritère matérialiser par la textbox1
et des textbox qui récupéré la ligne sélectionner dans la listview aussi des bouton ajouter,modifier,suprimer
donc voici mon souci je souhait liée l' userform 1 avec une table access a fin de pouvoir traiter un grand volume de donner
si vous avez une solution je vous joint les deux fichier a liée merci d'avance
Cordialement
Fichier Excel
https://www.cjoint.com/c/HDxkYumAidQ
Fichier Access
https://www.cjoint.com/c/HDxkWQbXqxQ

Afficher la suite

3 réponses

Résumé de la discussion

Intégration entre un formulaire UserForm1, une ListView et une base Access, avec recherche multicritère et boutons ajouter, modifier et supprimer, est au cœur de la discussion.
Plusieurs échanges portent sur lier l'UserForm1 à une table Access pour traiter un volume de données, avec une ListView colorant les lignes et une recherche multicritère, puis les opérations d'ajout, modification et suppression.
Des réponses notent que la requête SQL dépend des noms de champs et du type d'action souhaité, et que la recherche, l'ajout et la modification fonctionnent, avec souci sur le rafraîchissement après suppression.
Des éléments additionnels précisent que l'ouverture du bon fichier résout les incohérences et que le problème réside désormais uniquement dans le rafraîchissement de la ListView après une suppression.

Réponse 1 / 3
f894009 Messages postés 17417 Date d'inscription Statut Membre Dernière intervention 1 717

Bonjour,

Vous etes de la meme famille avec BLBATHOR???
Je regarde la chose
0
1. pyrus2047 Messages postés 156 Statut Membre
  
  Bonjour et merci
  oui il faut que je supprime un des compte
  
  0
2. f894009 Messages postés 17417 Date d'inscription Statut Membre Dernière intervention 1 717
  
  Re,
  
  C'est en bonne voie pour recherche. Ensuite je fais pour les boutons Ajout, modif, supprimer
  
  Mais, he oui, il y a un mais. Les noms de colonne listview ne correspondent pas avec les entetes de colonne de la table Access!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  
  J'ai trouve ce qui provoquait un temps d'execution tres long, deux boucles qui ne servent a rien en dehors de foutre le daoua dans le partie coloriage de la listview. C'est en décortiquant le code plus en detail, que je m'en suis aperçu vu que je dois le reecrire en partie. Je verifie sur le fichier Excel et si Ok, a vous de voir si nous continuons avec table access ou pas
  
  0
3. f894009 Messages postés 17417 Date d'inscription Statut Membre Dernière intervention 1 717
  
  Re,
  En effet, dans la mise a jour de la listview j'ai colle le code de coloriage sans faire attention aux deux boucles qui font vraiment durer le plaisir
  Table access et requete Sql, temps d'exec de 2.2s a 3.1s chez moi avec mon PC
  Feuille excel (avec les donnees table access) et travail en memoire, temps d'exec 0.5s de plus que table access
  
  A vous de voir
  
  0
4. pyrus2047 Messages postés 156 Statut Membre > f894009 Messages postés 17417 Date d'inscription Statut Membre Dernière intervention
  
  Re
  Merci a vous j'aimerai bien comprendre pourquoi c'est si long a l'execution
  je privilégie la version table access qui a l'aire plus rapide
  
  0
5. f894009 Messages postés 17417 Date d'inscription Statut Membre Dernière intervention 1 717
  
  Bonjour,
  
  Ci-joint
  un module avec les differentes procedures: https://mon-partage.fr/f/oPOgmNTQ/
  
  Fichier base BLBATHOR_ListView-Bis_2 modifier avec donnees table ACCESS dans feuille EXCEL:
  https://mon-partage.fr/f/afDsq7fM/
  
  Je continue sur la base ACCESS, pour les trois boutons
  
  Pourquoi pas de l'ACCESS complet, table et formulaire???
  
  0

f894009 Messages postés 17417 Date d'inscription Statut Membre Dernière intervention 1 717

Re,
Probleme de refereces, vous devez avoir ce qui est coche a la version prete

pyrus2047 Messages postés 156 Statut Membre

Re
voici mes references ca ne fonctionne pas

https://www.cjoint.com/c/HEisQyRshfb
0
f894009 Messages postés 17417 Date d'inscription Statut Membre Dernière intervention 1 717

Bonjour,

Oui, ce sont les meme que je n'ai pas changées depuis le debut...... et ca marche chez moi
0

pyrus2047 Messages postés 156 Statut Membre

Bonjour
J'ai cette connection qui fonctionne en liaison excel avec access
mais pas sur les machines qui dispose uniqeument du runtime access
si vous avez une solution pour l' adapter cette fonction et ce bout de code a votre méthode connection qui elle fonction
bien avec le runtime access
Cordialement

Function fMDP(Utilisateur As String, MdP As String) As Boolean
Dim ACapp As Access.Application, db As DAO.DATABASE, rTrouve As DAO.Recordset, sql As String
Dim ws As Worksheet, fd As DAO.Field

Set ACapp = New Access.Application
Set db = DBEngine.OpenDatabase("C:\Users\pyrus2047\Documents\ebergeur.accdb", False, False, ";pwd=PAPA")
sql = "select * from parametrage where NOM='" & Utilisateur & "' and [Mot de Passe] ='" & MdP & "'"

Set rTrouve = db.OpenRecordset(sql)
If rTrouve.EOF Then
    fMDP = False
Else
    fMDP = True
    For Each ws In ThisWorkbook.Sheets
        For Each fd In rTrouve.Fields
            If ws.Name = fd.Name Then
                If fd.Value = "X" Then
                    ws.Visible = True
                Else
                    ws.Visible = xlSheetVeryHidden
                End If
                Exit For
            End If
        Next fd
    Next ws
End If
db.Close
End Function

Option Explicit
Const c_t_parm As String = "Tombins"
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
Me.TextBox1 = ""
Me.TextBox2 = ""
Me.TextBox3 = ""
Me.TextBox4 = ""
Me.CheckBox1 = False
MsgBox "Votre enregistrement a ete modifier"
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
Me.TextBox1 = ""
Me.TextBox2 = ""
Me.TextBox3 = ""
Me.TextBox4 = ""
Me.CheckBox1 = False
End Sub
Private Sub CommandButton5_Click()
rcontacts.FindFirst ("[NOM PRENOM]='" & Me.TextBox1.Value & "'")
rcontacts.MovePrevious
On Error Resume Next
If Not rcontacts.BOF Then
Me.TextBox1.Text = rcontacts![XXXXXXXXX]
Me.TextBox2.Text = rcontacts![XXXXXXXXX]
Me.TextBox3.Text = rcontacts![XXXXXXXXXt]
Me.TextBox4.Text = rcontacts!XXXXXXXXX
Me.TextBox5.Text = rcontacts!XXXXXXXXX
Me.TextBox6.Text = rcontacts!XXXXXXXXX
Me.TextBox7.Text = rcontacts!XXXXXXXXX
Me.TextBox8.Text = rcontacts![XXXXXXXXX]
Me.TextBox9.Text = rcontacts!XXXXXXXXX
Me.TextBox10.Text = rcontacts![XXXXXXXXX]
Me.TextBox11.Text = rcontacts![XXXXXXXXX]
Me.TextBox12.Text = rcontacts![XXXXXXXXX]
Me.TextBox13.Text = rcontacts![XXXXXXXXX]
Me.TextBox14.Text = rcontacts![XXXXXXXXX]
    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
On Error Resume Next
If Not rcontacts.EOF Then
Me.TextBox1.Text = rcontacts![XXXXXXXXX]
Me.TextBox2.Text = rcontacts![XXXXXXXXX]
Me.TextBox3.Text = rcontacts![XXXXXXXXX]
Me.TextBox4.Text = rcontacts!XXXXXXXXX
Me.TextBox5.Text = rcontacts!XXXXXXXXX
Me.TextBox6.Text = rcontacts!XXXXXXXXX
Me.TextBox7.Text = rcontacts!XXXXXXXXX
Me.TextBox8.Text = rcontacts![XXXXXXXXX]
Me.TextBox9.Text = rcontacts!XXXXXXXXX
Me.TextBox10.Text = rcontacts![XXXXXXXXX]
Me.TextBox11.Text = rcontacts![XXXXXXXXX]
Me.TextBox12.Text = rcontacts![XXXXXXXXX]
Me.TextBox13.Text = rcontacts![XXXXXXXXX]
Me.TextBox14.Text = rcontacts![XXXXXXXXX]
    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()
Dim photo As String
On Error Resume Next
rcontacts.FindFirst ("[NOM PRENOM]='" & Me.ComboBox1.Value & "'")
Me.TextBox1.Text = rcontacts![XXXXXXXXX]
Me.TextBox2.Text = rcontacts![XXXXXXXXX]
Me.TextBox3.Text = rcontacts![XXXXXXXXX]
Me.TextBox4.Text = rcontacts!XXXXXXXXX
Me.TextBox5.Text = rcontacts!XXXXXXXXX
Me.TextBox6.Text = rcontacts!XXXXXXXXX
Me.TextBox7.Text = rcontacts!XXXXXXXXX
Me.TextBox8.Text = rcontacts![XXXXXXXXX]
Me.TextBox9.Text = rcontacts!XXXXXXXXX
Me.TextBox10.Text = rcontacts![XXXXXXXXX]
Me.TextBox11.Text = rcontacts![XXXXXXXXX]
Me.TextBox12.Text = rcontacts![XXXXXXXXX]
Me.TextBox13.Text = rcontacts![XXXXXXXXX]
Me.TextBox14.Text = rcontacts![XXXXXXXXX]
If rcontacts!PHOTOS = "oui" Then
            Me.CheckBox1 = True
            Else
            Me.CheckBox1 = False
End If
On Error GoTo defaut

photo = TextBox1.Value
Image1.Picture = LoadPicture("C:\Users\Pictures\" & photo & ".jpg")
Exit Sub

defaut:
Image1.Picture = LoadPicture("C:\Users\Pictures.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.jpg")
End Sub

Private Sub UserForm_Initialize()
Set ACapp = New Access.Application
Set db = ACapp.DBEngine.OpenDatabase _
    ("C:\Users\Abdessamad\Documents\table.accdb", False, False, ";pwd=PAPA")
Set rcontacts = db.OpenRecordset(c_t_parm, dbOpenDynaset)
Do While Not rcontacts.EOF
    ComboBox1.AddItem rcontacts![NOM PRENOM]
    rcontacts.MoveNext
Loop
End Sub

Réponse 3 / 3
castours Messages postés 2955 Date d'inscription Statut Membre Dernière intervention 217

Bonjour
Voire forum programmation VBA
0
1. f894009 Messages postés 17417 Date d'inscription Statut Membre Dernière intervention 1 717
  
  Bonjours Castours, ca roule?
  Certes, mais ce fichier marchait chez lui depuis le 24/04/2018 jusqu'a 07/05/2018 et apres verif de l'erreur, c'est bien un probleme soit de nom de base soit de chemin et pas de references
  Par-contre, il aurait du etre dans la partie VBA
  
  0
2. pyrus2047 Messages postés 156 Statut Membre
  
  Bonjour
  je m'excuse je fais perdre du temps a tout le monde
  le boulet a encore frapper c'est un espace a la fin du nom de la base qui a cause le bug
  pour clore le sujet
  que dois ton ajouter pour le cas ou la base et protéger par un mot de passe ex:PAPA
  
  0

Comment liée un userform avec une table access

3 réponses

Discussions similaires

Newsletters