Discussion :

[Invité]

Je viens de réaliser cela et avec 3 collègues de poste différent, nous avons procédés aux tests et pour le moment tout s'est bien déroulé.

Parfait le test est concluant nous pouvons passer au chose sérieuses !

A vrai dire j'ai pas bien compris cette partie de l'explication pour bien utiliser les 2 premiers codes.
Le premier doit-il être affecté à un bouton de mon usf et le second dans un module?

Pour ne pas avoir de redondance de code j’ai factorisé la connexion au fichier Fichier_Arrivé.xlsx.
Effectivement tu vas placer ce code dans un module séparé. De cette façon l’appel de la sub OpenConnexion(Fichier) vas faire le travaille sans coder autre chose !

Code Module standard :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Public Cnx As Object
Public Const Feuille = "BASE_DE_DONNEES$"
Public Const Fichier = "C:\Users\Robert\Desktop\Fichier_Arrivé.xlsx"
Sub OpenConnexion(Fichier)
    Set Cnx = CreateObject("ADODB.Connection")
    With Cnx
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
        & Fichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""
        .Open
    End With
End Sub

Code UserForm :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
Set requete = CreateObject("ADODB.recordset")
strSQL = "select * from [" & Feuille & "]  where  [NUM CLIENT]=]='" & Me.TextBox3 & "';"
requete.Open strSQL, Cnx
If requete.EOF = False Then
    MsgBox "Existe..."
Else
   strSQL = "insert into [" & Feuille & "] ([DATE_INITIATION],[NUM_CLIENT],[REVENU],[CUMUL_ENGAGEMENT],[VISA_DEMANDE],[DATE_INITIATION]) "
        strSQL = strSQL & "Values ('" & TextBox1.Value & "','" & TextBox2.Value & _
        "','" & TextBox3.Value & "','" & TextBox4.Value & "','" & TextBox5.Value & "','" & TextBox6.Value & "');"
    'et enfin on exécute la requête
    Cnx.Execute strSQL
End If
requete.Close
Set requete = Nothing
Cnx.Close 'on referme la connection
 
Set Cnx = Nothing

Quant au 3è code je vais le tester et vous revenir.
Autre chose:
Dans ce cas je pense que je dois décomposer les données de ma feuille "BASE_DE_DONNEES" en plusieurs feuilles. Par feuille je vais regrouper les entêtes de champs correspondants à un usf.
Exemple: mon usf1 est fait pour alimenter les 6 premières cellules (A:F). Je croyais qu'un autre usf pourrait alimenter la suite des champs mais vu cette condition "Les données doient être indiquées dans.....dans la base de données"
Si mon raisonnement n'est pas vrai merci de me le signaler.
Encore merci pour votre disponibilité.
Je remercie aussi les bonnes volontés pour leurs apports
Je vais

Code Uf_Cherche :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Private Sub Rechercher_Click()
OpenConnexion Fichier
Feuille = "BASE_DE_DONNEES"
Set requete = CreateObject("ADODB.recordset")
strSQL = "select * from [" & Feuille & "]  where  [NUM CLIENT]=]='" & Me.cherche_Code & "';"
requete.Open strSQL, Cnx
If requete.EOF = False Then
   Gestion_Users.TextBox1.Value = requete("DATE_INITIATION")
    Gestion_Users.Value = requete("NUM_CLIENT")
    Gestion_Users.TextBox3.Value = requete("REVENU")
    Gestion_Users.TextBox4.Value = requete("CUMUL_ENGAGEMENT")
    Gestion_Users.Value = requete("VISA_DEMANDE")
    Gestion_Users.Value = requete("DATE_INITIATION")
    Gestion_Users.Show
    requete.Close
    Cnx.Close
    Set Cnx = Nothing
    Set requete = Nothing
    Unload Me
End If
End Sub

[capi81]

Merci pour les codes proposés.
Lorsque j'exécute le débogage, il y'a un message d'erreur qui s'affiche dont le contenu est le suivant:
Erreur de compilation détecté:Feuille
J’essaie de comprendre pour trouver une solution mais j'y arrive pas.
Aussi comment devrais-je faire pour obtenir le résultat escompté.
Le premier code a été logé dans un module et le second dans mon usf comme vous l'avez souhaité.
Comment tester pour arriver au résultat.
J'ai la volonté de comprendre et j'y arriverai.

[Invité]

zip tes 2 fichier et poste le zip sur le forum car nous avons des évolutions depuis le début de nos conversation!

[Invité]

Regardes le Fichier joint!

[capi81]

Salut rdurupt et le forum

Merci pour le fichier et je m’excuse du temps mis pour vous revenir qui etait dû a un déplacement.
J’ai essayé de tester votre proposition et voici mes constats :
Usf Rechercher_users : cet usf fonctionne mais pas à 100%. En effet, lorsque je renseigne un NUM_CLIENT, si je clic sur le bouton « Rechercher », les éléments s’affichent dans les textbox (bien) mais lorsque je tente de rechercher au autre client, je remarque qu’à l’ouverture de l’usf(ou lorsque j’y suis toujours) ce sont les même informations de la recherche précédentes qui s’affichent lorsque je modifie le NUM_CLIENT, la nouvelle recherche est sans effet. A quoi servent les boutons « Valider » et « Annuler ». Lorsque je clic dessus, l’usf disparait sans que je constate un changement.
Usf :New_users : lorsque je renseign les textbox, en cliquant sur « valider » il y’a un message d’erreur :

Erreur d’exécution –2147217913(80040e07)’ :
Type de données incompatible dans l’expression du critère

La ligne contenant cette information a été souligne : Cnx.Execute strSQL

Après d'autres testes, je commence à comprendre un peu.
Usf new_users : je vois que si on renseigne uniquement des valeurs numériques dans tous les textbox, la copie des données se fait vers la base_de_donnée.
Mais si je renseigne des autres chose (alphabétique ou alpha-numerique), le message d'erreur intervient.
Il y'a lieu de revoir le format des des données à entrer dans les textbox.
Usf Rechercher_users:il fonctionne bien mais à condition qu'après une recherche on efface manuellement les données des textbox avant d'effectuer une nouvelle recherche.
A ce niveau je pense qu'il faut mettre un autre bouton intitulé "Suivant" dont le role sera de purger les données existantes et se positionner sur le textbox1 pour le mot clé de la nouvelle recherche à faire.
toujours avec cette même usf, la recherche n'est fructueuse que lorsqu'on renseigne uniquement des valeurs numeriques dans le textbox1.
Pouvez-vous faire en sorte que quelque soit le format du mot clé (valeur du textbox1), que la recherche puisse se faire sans problème.

[Invité]

dans le bouton de recherche, j'ouvre et referme Rechercher_Users ce qui efface tout dans Rechercher_Users

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Private Sub Rechercher_Click()
Rechercher_Users.Show vbModal 'j'ouvre le formulaire de recherche en modal pour éviter que le programme que le procédure continue
If Rechercher_Users.Annuler = True Then Unload Rechercher_Users: Exit Sub 'si je click sur annuler dans le UF rechercher_User
For i = 1 To 6 ' les bouton Valider masque Rechercher_Userset redonne la main 
 Me.Controls("TextBox" & i) = Rechercher_Users.Controls("TextBox" & i)
Next
Me.Tag = Me.TextBox2.Value 'j’affecte la clé unique au tag du formulaire c'est lui qui fait le lien entre l’ancienne valeur et la nouvelle si tu décide de modifier celle-ci 
Unload Rechercher_Users 'ferme le UF  Rechercher_Users
End Sub

cette fonction permet de faire une recherche avec n'importe quel contrôle si il y a un valeur dedans!
c'est pour cela qu'il faut effacé les valeur mai normalement elle devrait être vide

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Private Function recherUser() As String
Dim i As Long
Dim t
t = Array("", "[DATE_INITIATION]", "[NUM_CLIENT]", "[REVENU]", "[CUMUL_ENGAGEMENT]", "[VISA_DEMANDE]", "[AUTORISATION]")
 
For i = 1 To 6
If Me.Controls("TextBox" & i) <> "" Then
    If recherUser = "" Then
 
        recherUser = "Ucase(" & t(i) & ")='" & UCase(Me.Controls("TextBox" & i)) & "'"
    Else
         recherUser = recherUser & " AND ucase(" & t(i) & ")='" & UCase(Me.Controls("TextBox" & i)) & "'"
    End If
End If
Next
 
End Function

ces deux bouton ce contante de masquer le UF

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Private Sub CommandButton1_Click()
Me.Hide 'masque le UF et redonne la main
End Sub
 
Private Sub CommandButton2_Click()
Annuler = True
Me.Hide  'masque le UF et redonne la main
End Sub

en ce qui concerne New je ne comprend pas car ça marche chez moi! en réalité tout fonctionne chez mois sauf que j'avais oublié de refermer Rechercher_Users lors de l'annulation
si tu veux que la clé unique soit TextBox1.Value il faut modifier les close where un peut partout dans le code!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
'where Ucase([NUM_CLIENT])='" & UCase(Trim(TextBox2.Value)) & "';"
'Devient
where Ucase([DATE_INITIATION])='" & UCase(Trim(TextBox1.Value)) & "';"
'If rs.EOF = False And UCase(Trim(TextBox2.Value)) <> Me.Tag Then
'Devient
If rs.EOF = False And UCase(Trim(TextBox1.Value)) <> Me.Tag Then
'me.tag= TextBox2.Value
'devient
me.tag= TextBox.Value

regarder dans tout le code

Code Gestion_Users :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Private Sub CB_Modifier_Click()
Dim strSQL As String
Dim rs
OpenConnexion Fichier
Sql = "select * from  [" & Feuille & "] where Ucase([NUM_CLIENT])='" & UCase(Trim(TextBox2.Value)) & "';"
Set rs = CreateObject("adodb.recordset")
rs.Open Sql, Cnx
If rs.EOF = False And UCase(Trim(TextBox2.Value)) <> Me.Tag Then
MsgBox "Existe pour un autre"
Else
 
strSQL = "Update  [" & Feuille & "] Set [DATE_INITIATION]='" & Trim(TextBox1.Value) & _
"',[NUM_CLIENT]='" & Trim(TextBox2.Value) & "',[REVENU]='" & Trim(TextBox3.Value) & "'," & _
"[CUMUL_ENGAGEMENT]='" & Trim(TextBox4.Value) & "',[VISA_DEMANDE]='" & Trim(TextBox5.Value) & _
"',[AUTORISATION]='" & Trim(TextBox6.Value) & "' " & _
"where ucase([NUM_CLIENT])='" & UCase(Trim(Me.Tag)) & "';"
 
Cnx.Execute strSQL
End If
rs.Close
Set rs = Nothing
Cnx.Close
Set Cnx = Nothing
Unload Me
End Sub
 
Private Sub CommandButton1_Click()
New_Users.Show vbModal
End Sub
 
Private Sub Rechercher_Click()
Rechercher_Users.Show vbModal
If Rechercher_Users.Annuler = True Then Unload Rechercher_Users: Exit Sub
For i = 1 To 6
 Me.Controls("TextBox" & i) = Rechercher_Users.Controls("TextBox" & i)
Next
Me.Tag = Me.TextBox2.Value
Unload Rechercher_Users
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Private Sub CB_Modifier_Click()
Dim strSQL As String
Dim rs
OpenConnexion Fichier
Sql = "select * from  [" & Feuille & "] where [NUM_CLIENT]='" & Trim(TextBox2.Value) & "';"
Set rs = CreateObject("adodb.recordset")
rs.Open Sql, Cnx
If rs.EOF = False Then
MsgBox "Existe"
Else
strSQL = "insert into [" & Feuille & "] ([DATE_INITIATION],[NUM_CLIENT],[REVENU],[CUMUL_ENGAGEMENT],[VISA_DEMANDE],[AUTORISATION]) "
        strSQL = strSQL & "Values ('" & Trim(TextBox1.Value) & "','" & Trim(TextBox2.Value) & _
        "','" & Trim(TextBox3.Value) & "','" & Trim(TextBox4.Value) & "','" & _
        Trim(TextBox5.Value) & "','" & Trim(TextBox6.Value) & "');"
Cnx.Execute strSQL
End If
rs.Close
Set rs = Nothing
Cnx.Close
Set Cnx = Nothing
Unload Me
End Sub
Private Sub UserForm_Initialize()
Unload Gestion_Users
End Sub

Code Rechercher_Users :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Public Annuler As Boolean
Private Function recherUser() As String
Dim i As Long
Dim t
t = Array("", "[DATE_INITIATION]", "[NUM_CLIENT]", "[REVENU]", "[CUMUL_ENGAGEMENT]", "[VISA_DEMANDE]", "[AUTORISATION]")
 
For i = 1 To 6
If Me.Controls("TextBox" & i) <> "" Then
    If recherUser = "" Then
 
        recherUser = "Ucase(" & t(i) & ")='" & UCase(Me.Controls("TextBox" & i)) & "'"
    Else
         recherUser = recherUser & " AND ucase(" & t(i) & ")='" & UCase(Me.Controls("TextBox" & i)) & "'"
    End If
End If
Next
 
End Function
 
Private Sub CB_Rechercher_Click()
Dim strSQL As String
Dim rs
 
Dim Were As String
where = recherUser
If where = "" Then MsgBox "Petit malin si tu ne saisie pas de critère comment veux tu que je trouve ", vbQuestion: Exit Sub
Sql = "select * from  [" & Feuille & "] where " & where & ";"
OpenConnexion Fichier
Set rs = CreateObject("adodb.recordset")
rs.Open Sql, Cnx
If rs.EOF = True Then
MsgBox "Existe Pas"
Else
TextBox1 = rs("DATE_INITIATION")
TextBox2 = rs("NUM_CLIENT")
TextBox3 = rs("REVENU")
TextBox4 = rs("CUMUL_ENGAGEMENT")
TextBox5 = rs("VISA_DEMANDE")
TextBox6 = rs("AUTORISATION")
End If
rs.Close
Set rs = Nothing
Cnx.Close
Set Cnx = Nothing
End Sub
 
Private Sub CommandButton1_Click()
Me.Hide
End Sub
 
Private Sub CommandButton2_Click()
Annuler = True
Me.Hide
End Sub

Code Module1 :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Public Cnx As Object
Public Const Feuille = "BASE_DE_DONNEES$"
Public Const Fichier = "C:\Users\Robert\Desktop\Fichier_Arrivé.xlsx"
Sub RequetAjout()
 
Dim strSQL As String
OpenConnexion Fichier
strSQL = "insert into [" & Feuille & "] ([DATE INITIATION],[NUM CLIENT],[REVENU],[CUMUL ENGAGEMENT],[VISA DEMANDE],[AUTORISATION],[SOLDE AVANT VISA],[SOLDE APRES VISA],[SITUATION NETTE],[DELAI DE REGULARISATION],[COMMENTAIRE CC],[AVIS DGAE],[COMMENTAIRE DGAE],[AVIS RPR],[COMMENTAIRE RPR],[AVIS ANALYSTE],[COMMENTAIRE ANALYSTE],[AVIS DZ],[COMMENTAIRE DZ],[AVIS DR],[COMMENTAIRE DR],[AVIS RAR],[COMMENTAIRE RAR],[CODE INITIATEUR],[CODE VALIDEUR],[AGENCE],[DATE VALIDATION]) "
strSQL = strSQL & "Values ('DATE INITIATION','NUM CLIENT','REVENU','CUMUL ENGAGEMENT','VISA DEMANDE','AUTORISATION','SOLDE AVANT VISA','SOLDE APRES VISA','SITUATION NETTE','DELAI DE REGULARISATION','COMMENTAIRE CC','AVIS DGAE','COMMENTAIRE DGAE','AVIS RPR','COMMENTAIRE RPR','AVIS ANALYSTE','COMMENTAIRE ANALYSTE','AVIS DZ','COMMENTAIRE DZ','AVIS DR','COMMENTAIRE DR','AVIS RAR','COMMENTAIRE RAR','CODE INITIATEUR','CODE VALIDEUR','AGENCE','DATE VALIDATION');"
 
strSQL = "insert into [" & Feuille & "] ([DATE INITIATION],[NUM CLIENT],[REVENU],[CUMUL ENGAGEMENT],[VISA DEMANDE]) "
        strSQL = strSQL & "Values ('textbox2.value','textbox3.value','textbox4.value','textbox5.value','textbox6.value');"
Cnx.Execute strSQL
Set Cnx = Nothing
End Sub
Sub RequeteMaj()
OpenConnexion Fichier
Set requete = CreateObject("ADODB.recordset")
strSQL = "Update  [" & Feuille & "] set [NUM CLIENT]='toto'  where  [DATE INITIATION]='textbo(x2.value';"
Cnx.Execute strSQL
Cnx.Close
End Sub
Sub OpenConnexion(Fichier)
Set Cnx = CreateObject("ADODB.Connection")
 
With Cnx
 .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
            & Fichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""
        .Open
 
End With
 
End Sub

[capi81]

Salut rdurupt

Merci pour les codes et pour toute l'assistance.
J'aimerai si possible avoir votre fichier (prenant en compte les nouveaux codes que vous proposez) pour confronter avec mon fichier.
Je viens de commencer les tests car depuis le matin j'étais en réunion.

A bientôt

[Invité]

Voila la dernière version!

[capi81]

merci pour le fichier.
L'usf "Rechercher_users fonctionne aussi chez moi.
Mais l'usf new_users ne fonctionne pas ce moi et lorsque je clic sur "Valider", le message suivant s'affiche:

Erreur d’exécution ‘2147217913(80040e07)’ :
Type de données incompatible dans l’expression du critère

Comme je vous l'ai déjà signalé, je souhaite que le critère de recherche soit la valeur du textbox1.
Sauf erreur de ma part, il m'est difficile de pouvoir modifier les données d'un client existant.
Il serait bien qu'on y arrive (pour prendre en compte les changements qui pourraient survenir).
Merci d'apprécié le fichier joint (c'est le votre tenant compte de mes modifications).

[Invité]

donne moi un échantillon de VISA_CHEQUE.xlsx

[capi81]

le voici

[Invité]

CUMUL_ENGAGEMENT est considéré comme du numérique car il n'y a que des chiffres!

pour les test j'ai configuré la mise en forme de la feuille comme du texte.
bien sur si tu veux faire des calcule il faudra lui donner le bon format donc vérifier si le textbox son des numérique de date ou du texte.
fais tes testes avec les 2 fichier puis on en reparle!

[capi81]

Salut rdurupt

Mes tests sont concluant.
J'essaie maintenant d'adapter les codes à mes usf réels.
Il faut noter que j'ai été amené à recadrer les entêtes de mes champs.
J'ai regroupé les informations de même nature par feuille.
La feuille "BASE_DE_DONNEES" a été découpée en 5 feuilles (BASE_DE_DONNEES, USER_LIST, AVIS_VALIDEUR, CONSULTATION).
Donc un usf sera crée pour alimenter chaque feuille.
En attendant que je finalise cela, pouvez-vous prendre en considération cette observation:
usf "Rechercher":je souhaite pouvoir y faire des modifications. Si je fais une recherche sur un user et que ses informations s'affichent dans les textbox, pouvez-vous ajouter un bouton "Modifier" qui permettra d'actualiser les informations du user si je venais à faire des modifications?
Merci et à bientôt

[Invité]

j'ai modifier le bouton rechercher pour tenir compte que du champ [DATE_INITIATION] (TextBox1)!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Private Sub CB_Rechercher_Click()
Dim strSQL As String
Dim rs
 
Dim Were As String
where = recherUser
If Me.TextBox1 = "" Then MsgBox "Petit malin si tu ne saisie pas de critère comment veux tu que je trouve ", vbQuestion: Exit Sub
Sql = "select * from  [" & Feuille & "] where [DATE_INITIATION]='" & Me.TextBox1 & "';"
OpenConnexion Fichier
Set rs = CreateObject("adodb.recordset")
rs.Open Sql, Cnx
If rs.EOF = True Then
MsgBox "Existe Pas"
Else
TextBox1 = rs("DATE_INITIATION")
TextBox2 = rs("NUM_CLIENT")
TextBox3 = rs("REVENU")
TextBox4 = rs("CUMUL_ENGAGEMENT")
TextBox5 = rs("VISA_DEMANDE")
TextBox6 = rs("AUTORISATION")
End If
rs.Close
Set rs = Nothing
Cnx.Close
Set Cnx = Nothing
End Sub

maintenant tu peux réactualisé en cliquant à nouveau sur rechercher.

[capi81]

Je viens de tester en remplacant l'ancien code par le nouveau.
Usf Rechercher_user: Lorsque je renseigne le textbox1 et que je clic sur rechercher, les informations s'affichent dans les textbox (ce qui est bien).
Sans quitter l'usf si je modifie une information d'un user et que je clic à nouveau sur "Rechercher", je constate pas de changement dans les informations du User (biensur dans la base_visa). Votre test a t-il été concluant?
Encore merci pour le coaching que j'apprécie.

[Invité]

le UF rechercher n'a pas pour objet de modifier les valeurs dans la base_visa mais d’afficher le résultat de la recherche quand tu valide les valeur se retrouve dans Gestion_Users et c'est là que les modification seront prise en comptes!
si tu veux que ca fonctionne comme ça il faut prendre le code du bouton rechercher de CB_Rechercher e l’adapter au Gestion_Users

Code Gestion_Users :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Private Sub Rechercher_Click()
Rechercher_Users.Show vbModal
If Rechercher_Users.Annuler = True Then Unload Rechercher_Users: Exit Sub
For i = 1 To 6
 Me.Controls("TextBox" & i) = Rechercher_Users.Controls("TextBox" & i)
Next
Me.Tag = Me.TextBox1.Value
Unload Rechercher_Users
End Sub

Devient

Code Gestion_Users :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Private Sub Rechercher_Click()
Dim strSQL As String
Dim rs
 
Dim Were As String
where = recherUser
If Me.TextBox1 = "" Then MsgBox "Petit malin si tu ne saisie pas de critère comment veux tu que je trouve ", vbQuestion: Exit Sub
Sql = "select * from  [" & Feuille & "] where [DATE_INITIATION]='" & Me.TextBox1 & "';"
OpenConnexion Fichier
Set rs = CreateObject("adodb.recordset")
rs.Open Sql, Cnx
If rs.EOF = True Then
MsgBox "Existe Pas"
Else
TextBox1 = rs("DATE_INITIATION")
TextBox2 = rs("NUM_CLIENT")
TextBox3 = rs("REVENU")
TextBox4 = rs("CUMUL_ENGAGEMENT")
TextBox5 = rs("VISA_DEMANDE")
TextBox6 = rs("AUTORISATION")
End If
rs.Close
Set rs = Nothing
Cnx.Close
Set Cnx = Nothing
Me.Tag = Me.TextBox1.Value
End Sub

et j’avoue que c'est une bonne idée!

[capi81]

Salut rdurupt et le forum

Actuellement je suis entrain de finaliser la modélisation de mes usf pour mon projet réel.
Avec les expériences déjà acquises grâce à votre coaching, je vais utiliser les codes reçus pour l'adapter avec mes nouveaux usf et vous revenir pour la suite.
Je voulais m'assurer d'une chose, les derniers codes que vous m'avez donnés fonctionnent t-ils bien chez vous (les modifications des données d'un users sont-elles prises en compte avec votre dernier fichier?).
Malgré mes essais, je ne constate pas de modification.
Merci de me donner votre fichier pour comparaison si possible.
Encore merci.

[Invité]

Bonjour,
avant de passer le fichier en mode partagé, je voyais les modification en direct, mais que je refermai le fichier il me demandait si je voulais enregistrer.
si je disais oui je retrouvai les valeurs à a réouverture, si je disais nom il me les effaçait!

en mode partagé il ne me les affiche que si je referme et ré-ouvre. je regarde pour une astuce.

[capi81]

Salut rdurupt

Je vous joint 2 fichiers pour appréciation.
L'usf Gest_penal est une composante du projet réel.
Je constate certaines annomalies et souhaiterai avoir votre appréciation.
Voici mes constats:
d'abord il faut noter que j'ai essayé de modifier le code Requete_ajout.
Le code initial était configuré pour une seule feuille mais dans mon cas réel, le collage se fera en fonction de l'usf actif (chaque usf est fait pour alimenter une feuille précise dans le fichier).
- je constate une erreur dans le textobjet de l'usf Gest_penal ("erreur de syntaxe").
- Comme vous pouvez le constater dans le fichier MODELE_VISA_zb, le collage commence en A7 et non en A2.
Comment résoudre ces difficultés?
N.B : l'usf à tester est représenté par le bouton "ESSAI".

Salut le forum

Je cherche de l'aide portant sur le contenu de ma combobox.
En effet, j'ai un classeur nommé "Modele1" (classeur fermé) donT le chemin d'accès est

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

"Z:\VISA_CHEQUE\MODELE_VISA_zb.xlsx"

.
J'ai un autre classeur (actif) intitulé "BOULEVARD" qui comportant un usf.
L'usf comporte une combobox.
Je souhaite que la plage User_List!A2:A150 du classeur fermé soit les éléments de la liste de ma combobox.
Comment se connexter au classeur fermé pour réaliser mon besoin.
Voici ce que j'ai essayé de faire:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ComboBox1.List = Workbooks("MODELE_VISA_zb").Worksheets("USER_LIST").Range("A2:A" & Workbooks("MODELE_VISA_zb").Worksheets("USER_LIST").Range("A2" & Rows.Count).End(xlUp).Row).Value

mais le message d'erreur suivant appapait :Erreur d'exécution "9"("L'indice n'appartient pas à la sélection")
N.B : le classeur fermé se trouve dans un dossier dont le chemin d'accès se trouve ci-dessus.
Merci

En me référant au code de rdurupt (que je salut encore) de mon module1 ci-dessous, je me suis dis que la solution ne devrait pas s'y écartée.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Public Cnx As Object, Cnx1 As Object
Public Const Feuille = "USER_LIST$"
Public Const Feuille1 = "BASE_DE_DONNEES$"
Public Const Fichier = "Z:\VISA_CHEQUE\MODELE_VISA_zb.xlsx"
Dim strsQL As String
Sub RequetAjout()
 
OpenConnexion Fichier
strsQL = "insert into [" & Feuille & "] ([USER_CODE],[CODE_EXPL],[NOM_EXPLOITANT],[CONTACTS],[ADRESSE_MAIL_EXPLOITANT],[ADRESSE_MAIL_DA]) "
strsQL = strsQL & "Values ('USER_CODE','CODE_EXPL','NOM_EXPLOITANT','CONTACTS','ADRESSE_MAIL_EXPLOITANT','ADRESSE_MAIL_DA');"
 
strsQL = "insert into [" & Feuille & "] ([USER_CODE],[CODE_EXPL],[NOM_EXPLOITANT],[CONTACTS],[ADRESSE_MAIL_EXPLOITANT],[ADRESSE_MAIL_DA]) "
strsQL = strsQL & "Values ('textbox1.value','textbox2.value','textbox3.value','textbox4.value','textbox5.value'textbox6.value');"
Cnx.Execute strsQL
Set Cnx = Nothing
End Sub
Sub RequeteMaj()
OpenConnexion Fichier
Set requete = CreateObject("ADODB.recordset")
strsQL = "Update  [" & Feuille & "] set [USER_CODE]='toto'  where  [USER_CODE]='textbox1.value';"
Cnx.Execute strsQL
Cnx.Close
End Sub
Sub OpenConnexion(Fichier)
Set Cnx = CreateObject("ADODB.Connection")
 
With Cnx
 .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
            & Fichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""
        .Open
 
End With
 
End Sub

Voici ce que j'ai essayé de refaire mais je rencontre une erreur de compilation ("Tableau attendu") et le 2è fichier en gras a été souligné:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Private Sub UserForm_Initialize()
ComboBox1.List = Fichier(Feuille).Range("A2:A" & Fichier(Feuille).Range("A" & Rows.Count).End(xlUp).Row).Value
End Sub

Merci pour vos éventuelles contributions

Salut rdurupt et le forum

Je viens pour apporter des réponses à mon post précédent.

- je constate une erreur dans le textobjet de l'usf Gest_penal ("erreur de syntaxe").

Après plusieurs autres tests, je constate que l'erreur ne se produit plus (donc résolu).

Comme vous pouvez le constater dans le fichier MODELE_VISA_zb, le collage commence en A7 et non en A2.
Comment résoudre ces difficultés?

Ici aussi , je pense avoir compris la cause de l'erreur.
En effet, j'ai remarqué que si j'efface les données de ma "BASE_DE_DONNEES", dans l'espoir que le collage recommencera en A2, je me trompe. Pour la macro, rien n'est effacé, il continu le collage comme si rien n'a été effacé (pas en A2 mais toujours à la suite de la dernière ligne effacée).
Pour m'assuré que mon raisonnement est logique, j'ai crée une nouvelle feuille en lieu et place de la feuille "BASE_DE_DONNEES" (après avoir supprimé l'ancienne feuille "BASE_DE_DONNEES").
En réalisant le test, le collage se fait en A2.
Ensuite j'ai effacé les données de la ligne 2 et quand j'ai exécuté la macro, les données ont été collées sur la ligne 3.
Ce qui me permet de tirer mes conclusions : les inquiétudes du post précédent ont été résolu donc nous pouvons continuer sur les autres points non encore abordé.