Lenteur données feuille calcul et USF

[rcan7412]

Je souhaite récupérer les données de 15 combos et 15 textbox d'un usf vers 2 x 15 cellules d'une feuille de calcul.
A l'initialisation de l'usf, je souhaite qu'il récupére le contenue des 2x15 cellules (si non-vide).
J'y suis arrivé mais le processus prend un temps incroyable. Je pense que mon code est sans doute mal torché.
Le ralentissement est subi par la lecture des données de la feuille de calcul vers l'usf via la propriété 'Control source'.
N'y-a-til pas moyen de procéder autrement ?

Voici le code :

Private Sub Userform_Initialize()
'necessite d'activer la reference Microsoft ActiveX Data Objects x.x Lib rary
Dim Cn As ADODB.Connection
Dim Rs As ADODB.Recordset
Dim Chemin As String, Cible As String, laBase As String

'Chemin du comptes.dbf du dossier choisi
Chemin = Sheets('Calcul').Range('REPEVOL') & '\\' & Sheets('Calcul').Range('REPDOS')
laBase = 'Comptes.dbf'


With ComboBox1
.ColumnCount = 2 'nombre de colonnes
.ColumnWidths = '50;80' 'largeur colonnes
End With


With ComboBox2
.ColumnCount = 2 'nombre de colonnes
.ColumnWidths = '50;80' 'largeur colonnes
End With

With ComboBox3
.ColumnCount = 2 'nombre de colonnes
.ColumnWidths = '50;80' 'largeur colonnes
End With

With ComboBox4
.ColumnCount = 2 'nombre de colonnes
.ColumnWidths = '50;80' 'largeur colonnes
End With

With ComboBox5
.ColumnCount = 2 'nombre de colonnes
.ColumnWidths = '50;80' 'largeur colonnes
End With

With ComboBox6
.ColumnCount = 2 'nombre de colonnes
.ColumnWidths = '50;80' 'largeur colonnes
End With

With ComboBox7
.ColumnCount = 2 'nombre de colonnes
.ColumnWidths = '50;80' 'largeur colonnes
End With

With ComboBox8
.ColumnCount = 2 'nombre de colonnes
.ColumnWidths = '50;80' 'largeur colonnes
End With

With ComboBox9
.ColumnCount = 2 'nombre de colonnes
.ColumnWidths = '50;80' 'largeur colonnes
End With

With ComboBox10
.ColumnCount = 2 'nombre de colonnes
.ColumnWidths = '50;80' 'largeur colonnes
End With

With ComboBox11
.ColumnCount = 2 'nombre de colonnes
.ColumnWidths = '50;80' 'largeur colonnes
End With

With ComboBox12
.ColumnCount = 2 'nombre de colonnes
.ColumnWidths = '50;80' 'largeur colonnes
End With

With ComboBox13
.ColumnCount = 2 'nombre de colonnes
.ColumnWidths = '50;80' 'largeur colonnes
End With

With ComboBox14
.ColumnCount = 2 'nombre de colonnes
.ColumnWidths = '50;80' 'largeur colonnes
End With

With ComboBox15
.ColumnCount = 2 'nombre de colonnes
.ColumnWidths = '50;80' 'largeur colonnes
End With

Set Cn = New ADODB.Connection
Cn.Open _
'Driver={Microsoft dBASE Driver (*.dbf)};DriverID=277;Dbq=' & _
Chemin & ';'

'requête pour la recuperation des champs COMP ,INTI
Cible = 'SELECT COMP,INTI FROM ' & laBase & ' ORDER BY COMP ;'

Set Rs = New Recordset
Rs.Open Cible, Cn, adOpenKeyset, adLockOptimistic

Do While Not Rs.EOF
ComboBox1.AddItem Rs.Fields(0).Value 'champ COMP
ComboBox1.List(ComboBox1.ListCount - 1, 1) = Rs.Fields(1).Value 'champ INTI
ComboBox2.AddItem Rs.Fields(0).Value 'champ COMP
ComboBox2.List(ComboBox2.ListCount - 1, 1) = Rs.Fields(1).Value 'champ INTI
ComboBox3.AddItem Rs.Fields(0).Value 'champ COMP
ComboBox3.List(ComboBox3.ListCount - 1, 1) = Rs.Fields(1).Value 'champ INTI
ComboBox4.AddItem Rs.Fields(0).Value 'champ COMP
ComboBox4.List(ComboBox4.ListCount - 1, 1) = Rs.Fields(1).Value 'champ INTI
ComboBox5.AddItem Rs.Fields(0).Value 'champ COMP
ComboBox5.List(ComboBox5.ListCount - 1, 1) = Rs.Fields(1).Value 'champ INTI
ComboBox6.AddItem Rs.Fields(0).Value 'champ COMP
ComboBox6.List(ComboBox6.ListCount - 1, 1) = Rs.Fields(1).Value 'champ INTI
ComboBox7.AddItem Rs.Fields(0).Value 'champ COMP
ComboBox7.List(ComboBox7.ListCount - 1, 1) = Rs.Fields(1).Value 'champ INTI
ComboBox8.AddItem Rs.Fields(0).Value 'champ COMP
ComboBox8.List(ComboBox8.ListCount - 1, 1) = Rs.Fields(1).Value 'champ INTI
ComboBox9.AddItem Rs.Fields(0).Value 'champ COMP
ComboBox9.List(ComboBox9.ListCount - 1, 1) = Rs.Fields(1).Value 'champ INTI
ComboBox10.AddItem Rs.Fields(0).Value 'champ COMP
ComboBox10.List(ComboBox10.ListCount - 1, 1) = Rs.Fields(1).Value 'champ INTI
ComboBox11.AddItem Rs.Fields(0).Value 'champ COMP
ComboBox11.List(ComboBox11.ListCount - 1, 1) = Rs.Fields(1).Value 'champ INTI
ComboBox12.AddItem Rs.Fields(0).Value 'champ COMP
ComboBox12.List(ComboBox12.ListCount - 1, 1) = Rs.Fields(1).Value 'champ INTI
ComboBox13.AddItem Rs.Fields(0).Value 'champ COMP
ComboBox13.List(ComboBox13.ListCount - 1, 1) = Rs.Fields(1).Value 'champ INTI
ComboBox14.AddItem Rs.Fields(0).Value 'champ COMP
ComboBox14.List(ComboBox14.ListCount - 1, 1) = Rs.Fields(1).Value 'champ INTI
ComboBox15.AddItem Rs.Fields(0).Value 'champ COMP
ComboBox15.List(ComboBox15.ListCount - 1, 1) = Rs.Fields(1).Value 'champ INTI
Rs.MoveNext
Loop

Rs.Close
Cn.Close
End Sub
Private Sub ComboBox1_Change()
Sheets('Complet').Range('B49') = ComboBox1
TextBox1 = ComboBox1.List(ComboBox1.ListIndex, 1) ''INTI
End Sub
Private Sub ComboBox2_Change()
TextBox2 = ComboBox2.List(ComboBox2.ListIndex, 1) ''INTI
End Sub
Private Sub ComboBox3_Change()
TextBox3 = ComboBox3.List(ComboBox3.ListIndex, 1) ''INTI
End Sub
Private Sub ComboBox4_Change()
TextBox4 = ComboBox4.List(ComboBox4.ListIndex, 1) ''INTI
End Sub
Private Sub ComboBox5_Change()
TextBox5 = ComboBox5.List(ComboBox5.ListIndex, 1) ''INTI
End Sub
Private Sub ComboBox6_Change()
TextBox6 = ComboBox6.List(ComboBox6.ListIndex, 1) ''INTI
End Sub
Private Sub ComboBox7_Change()
TextBox7 = ComboBox7.List(ComboBox7.ListIndex, 1) ''INTI
End Sub
Private Sub ComboBox8_Change()
TextBox8 = ComboBox8.List(ComboBox8.ListIndex, 1) ''INTI
End Sub
Private Sub ComboBox9_Change()
TextBox9 = ComboBox9.List(ComboBox9.ListIndex, 1) ''INTI
End Sub
Private Sub ComboBox10_Change()
TextBox10 = ComboBox10.List(ComboBox10.ListIndex, 1) ''INTI
End Sub
Private Sub ComboBox11_Change()
TextBox11 = ComboBox11.List(ComboBox11.ListIndex, 1) ''INTI
End Sub
Private Sub ComboBox12_Change()
TextBox12 = ComboBox12.List(ComboBox12.ListIndex, 1) ''INTI
End Sub
Private Sub ComboBox13_Change()
TextBox13 = ComboBox13.List(ComboBox13.ListIndex, 1) ''INTI
End Sub
Private Sub ComboBox14_Change()
TextBox14 = ComboBox14.List(ComboBox14.ListIndex, 1) ''INTI
End Sub
Private Sub ComboBox15_Change()
TextBox15 = ComboBox15.List(ComboBox15.ListIndex, 1) ''INTI
End Sub

 

[JC de Lorient]

salut

g pas tout regardé mais en effet àa me semble un peu complexe
le plus simple serait que tu puisses joindre un bout de ton fichier avec quelques explications si nécessaires
fichier zippé de -50k

JC

 

[justine]

bonjour le forum, rcan7412

j'ai remarqué que tu as beaucoup de meme code sauf que le numero change.

fais comme ce qui suit
for i = 1 to 15
With controls('ComboBox' & i)
.ColumnCount = 2 'nombre de colonnes
.ColumnWidths = '50;80' 'largeur colonnes
End With
next

pareil pour le reste

for i = 1 to 15
controls('ComboBox' & i).AddItem Rs.Fields(0).Value 'champ COMP
controls('ComboBox' & i).List(controls('ComboBox' & i).ListCount - 1, 1) = Rs.Fields(1).Value 'champ INTI
next

ainsi de suite

justine

 

[justine]

re

pour les textbox:

place une variable publique et fait appel a une macro

Private Sub ComboBox2_Change()
var=2
coucou
End Sub

sub coucou()
controls('TextBox'& var) = controls('ComboBox' & var).List(controls('ComboBox' & var).ListIndex, 1)) ''INTI
end sub

 

[rcan7412]

Merci Jc et Justine pour vos réponses.

Jc, je veux bien joindre un fichier, mais le problème c'est que dans le code il est fait appel à une reqûête sql pour obtenir les données.

Justine, j'ai déjà bien simplifié le code selon tes indications. Cela fait pas mal de lignes en moins. Seulement l'appel du usf est toujours très lent.

Contrairement à ce que j'ai écrit ne serait-ce pas le remplissage de chaque combobox avec les données de la requête sql qui ralenti le smilblic (via le Do while) ?
En fait le contenu de la liste de chaque combo est identique. C'est le choix qui va différencier chaque combobox.

D'autre part, je n'ai pas tout saisi ta remarque sur les textbox. Où déclarer la variable publique ? La macro est à insérer dans un module ? Et, il faut faire une private sub par Combobox ?

Désolé, mais je suis novice...

Private Sub Userform_Initialize()
'necessite d'activer la reference Microsoft ActiveX Data Objects x.x Lib rary
Dim Cn As ADODB.Connection
Dim Rs As ADODB.Recordset
Dim Chemin As String, Cible As String, laBase As String
Dim i As Integer

'Chemin du comptes.dbf du dossier choisi
Chemin = Sheets('Calcul').Range('REPEVOL') & '\\' & Sheets('Calcul').Range('REPDOS')
laBase = 'Comptes.dbf'

For i = 1 To 15
With Controls('ComboBox' & i)
.Clear
.ColumnCount = 2 'nombre de colonnes
.ColumnWidths = '50;80' 'largeur colonnes
End With
Next


Set Cn = New ADODB.Connection
Cn.Open _
'Driver={Microsoft dBASE Driver (*.dbf)};DriverID=277;Dbq=' & _
Chemin & ';'

'requête pour la recuperation des champs COMP ,INTI
Cible = 'SELECT COMP,INTI FROM ' & laBase & ' ORDER BY COMP ;'

Set Rs = New Recordset
Rs.Open Cible, Cn, adOpenKeyset, adLockOptimistic


Do While Not Rs.EOF
For i = 1 To 15
Controls('ComboBox' & i).AddItem Rs.Fields(0).Value 'champ COMP
Controls('ComboBox' & i).List(Controls('ComboBox' & i).ListCount - 1, 1) = Rs.Fields(1).Value 'champ INTI
Next
Rs.MoveNext
Loop

Rs.Close
Cn.Close
End Sub

 

[justine]

re
pour mettre une variable publique il faut la rentrer tout en haut de ta page ou tu rentres toutes tes macros, avant les SUB...()
si tu mets ta variable dans une SUB elle aura effet jusqu'a ce qu'elle rencontre END SUB (on dit qu'elle est privee) et perdra sa valeur ensuite

la macro COUCOU est a lancer dans chaque Private Sub ComboBox..._Change(), la tu changes la valeur de ta variable VAR
etant donnée que la textbox8 joue avec la combobox8, tu mets var=8, ainsi de suite, cela epargne de marquer des longues lignes identiques.

 

[rcan7412]

Merci beaucoup justine pour toutes les infos.
Pour ceux que ça intéresse, la lenteur de mon code résidait en effet dans l'alimentation de 15 combobox avec un contenu identique.

Sur base du fil :
Lien supprimé

J'ai pu résoudre mon problème, en récupérant le contenu de la combobox 1 vers les autres. C'est simple, mais il fallait y penser.

Voilà le code

Option Explicit
Public vartxt As Byte
'Bouton OK
Private Sub CommandButton1_Click()
'on ferme l'userform
Calculer
Unload Me
End Sub
Private Sub Image1_Click()
EffaceFavoris
End Sub
Private Sub Userform_Initialize()
'necessite d'activer la reference Microsoft ActiveX Data Objects x.x Lib rary
Dim Cn As ADODB.Connection
Dim Rs As ADODB.Recordset
Dim Chemin As String, Cible As String, laBase As String
Dim i As Integer
Dim n As Integer
Dim j As Integer

'Chemin du comptes.dbf du dossier choisi
Chemin = Sheets('Calcul').Range('REPEVOL') & '\\' & Sheets('Calcul').Range('REPDOS')
laBase = 'Comptes.dbf'


For i = 1 To 15
With Controls('ComboBox' & i)
.Clear
.ColumnCount = 2 'nombre de colonnes
.ColumnWidths = '50;80' 'largeur colonnes
End With
Next

Set Cn = New ADODB.Connection
Cn.Open _
'Driver={Microsoft dBASE Driver (*.dbf)};DriverID=277;Dbq=' & _
Chemin & ';'

'requête pour la recuperation des champs COMP ,INTI
Cible = 'SELECT COMP,INTI FROM ' & laBase & ' ORDER BY COMP ;'

Set Rs = New Recordset
Rs.Open Cible, Cn, adOpenKeyset, adLockOptimistic

'alimente la combobox 1 avec le fichier comptes.dbf (plan comptable)
Do While Not Rs.EOF
Controls('ComboBox1').AddItem Rs.Fields(0).Value 'champ COMP
Controls('ComboBox1').List(Controls('ComboBox1').ListCount - 1, 1) = Rs.Fields(1).Value 'champ INTI
Rs.MoveNext
Loop

'alimente les combobox 2 à 15 avec la liste de la combobox 1
For i = 2 To 15
Controls('ComboBox' & i).List = ComboBox1.List
Next

Rs.Close
Cn.Close
End Sub
Sub AlimText()
Controls('TextBox' & vartxt) = Controls('ComboBox' & vartxt).List(Controls('ComboBox' & vartxt).ListIndex, 1)   ''INTI
End Sub
Private Sub ComboBox1_Change()
vartxt = 1
AlimText
End Sub
Private Sub ComboBox2_Change()
vartxt = 2
AlimText
End Sub

 

[PascalXLD]

Bonjour

Pour ceux que ça interesse on peut eviter de passer par une variable public en faisant

Sub AlimText(vartxt as byte)

Controls(\\'TextBox\\' & vartxt) = Controls(\\'ComboBox\\' & vartx
t).List(Controls(\\'ComboBox\\' & vartxt).ListIndex, 1) ''INTI

End Sub

Private Sub ComboBox1_Change()

AlimText 1

End Sub

Private Sub ComboBox2_Change()

AlimText 2

End Sub

Bon courage

 

[rcan7412]

Merci Pascal
Ton idée n'est pas mal en effet !

J'ai encore un problème. Dans ma combobox, quand j'efface son contenu avec le backspace et que j'arrive à tout effacer, il me lance un message : 'Erreur d'éxécution 381 - Impossible de lire la propriété List.Index de table de propriétés non valide'

Et il me bloque sur
Controls('TextBox' & vartxt) = Controls('ComboBox' & vartxt).List(Controls('ComboBox' & vartxt).ListIndex, 1) ''INTI

Cela ne veut-il pas dire qu'il n'accepte pas de vavaleur nulle ?