Défilement de mots dans deux texbox

Version imprimable

1 pièce(s) jointe(s)

Dans la colonne A de la feuille 2 j'ai au maximum 250 mots anglais avec la traduction dans la colonne B

Je souhaite en appuyant sur un bouton "Démarrage" faire défiler ces mots dans deux texbox avec un rythme de 1 mots par seconde.

Voilà le code :
Code:

1 2 3 4 5 6 7 8 For i = 1 To Worksheets("Feuil2").Range("A1:A250").End(xlDown).Row Acceuil.TextBox_English.Value = Worksheets("Feuil2").Range("A" & i) Acceuil.TextBox_Français.Value = Worksheets("Feuil2").Range("B" & i) Application.Wait Time + TimeSerial(0, 0, 1) Next i
Problème :

Cela fonctionne correctement mais uniquement en réalisant une manipulation hasardeuse ^^

1) Cliquer sur le bouton "démarrage" dans le userform
2) Cliquer sur l'icone excel dans la barre inférieure
3) Ne plus rien toucher jusqu'à la fin

Si je ne clique pas sur l'icone excel, le programme de défilement s’exécute mais n'affiche pas les mots dans la texbox.

Hypothèse : Je pense que le userform doit être inactif lors de l’exécution du code, pour le moment je n'ai pas trouver la solution en code :(

Pièce jointe 168999

14/02/2015, 15h51
Daniel.C

Bonjour,
Mets un "DoEvents" avant et après ton instruction 'Wait".
14/02/2015, 15h51
Marc-L

Bonjour,

essayer avant la pause d'abord avec la fonction DoEvents et le cas échéant avec la méthode Repaint …

__________________________________________________________________________________________________

Merci de cliquer sur :plusser: pour chaque message ayant aidé puis sur :resolu: pour clore cette discussion …

__________________________________________________________________________________________________
Tous unis, tous Charlie

Code:

1 2 3 4 5 6 7 8 For i = 1 To Worksheets("Feuil2").Range("A1:A250").End(xlDown).Row Acceuil.TextBox_English.Value = Worksheets("Feuil2").Range("A" & i) Acceuil.TextBox_Français.Value = Worksheets("Feuil2").Range("B" & i) DoEvents Application.Wait Time + TimeSerial(0, 0, 1) Next i
Les deux méthodes fonctionnent

DoEvents : Bien, avec cependant le cercle bleu de la souris qui tourne en permanence durant l’exécution (Si il y a moyen de le retirer, je suis preneur).
Repaint : Bien, sans cercle bleu de la souris mais le userform scintille de temps en temps.

Merci pour l'information

14/02/2015, 17h15
Daniel.C

Au lieu de "Wait", utilise la méthode "OnTime".

Voilà le code en entier avec une ComboBox_Tps_Attente qui peut prendre la valeur 1 2 ou 3

1) Ontime réclame une procédure Application.OnTime Now + TimeValue("00:00:01"), ......... ?, je mets quoi puisqu'il y a pas de procédure à exécuter ?
2) Application.OnTime Now + TimeValue("00:00:01"), le 01 en gras doit prendre la valeur ComboBox_Tps_Attente.value
Code:

1 2 3 4 5 6 7 8 9 10 11 For i = 1 To Worksheets("Feuil2").Range("A1:A250").End(xlDown).Row Acceuil.TextBox_English.Value = Worksheets("Feuil2").Range("A" & i) Acceuil.TextBox_Français.Value = Worksheets("Feuil2").Range("B" & i) 'Acceuil.Repaint ' actualise userform 'Application.Wait Time + TimeSerial(0, 0, ComboBox_Tps_Attente.Value) DoEvents Application.OnTime Now + TimeValue("00:00:01") Next i

En tête de module :

Code:

Public Ctr As Long

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub test()
    Application.OnTime Now + TimeValue("00:00:01"), "ChangeTextbox"
End Sub
Sub ChangeTextbox()
    Dim Intervalle
    Ctr = Ctr + 1
    Intervalle = Now + TimeValue("00:00:1")
    Application.OnTime Intervalle, "ChangeTextbox"
    Acceuil.TextBox_English.Value = Worksheets("Feuil2").Range("A" & I)
    Acceuil.TextBox_Français.Value = Worksheets("Feuil2").Range("B" & I)
    If Ctr = Worksheets("Feuil2").Range("A1:A250").End(xlDown).Row Then
        Application.OnTime Intervalle, "ChangeTextbox", Schedule:=False
    End If
End Sub

15/02/2015, 11h05
baryum

La première méthode avec repaint me convient mais par curiosité j'ai essayé ton code sur un fichier excel plus simple mais reprenant le même principe. N'arrivant pas à joindre une pièce jointe dans ce message je te met un lien vers le fichier excel en partage. Pour le moment ton code ne fonctionne pas.

https://mon-partage.fr/f/IXx0bjUA/

cdt

Au temps pour moi (et pour toi) Voici les modifs :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub ChangeTextbox()
 
Dim Intervalle As Variant
 
I = I + 1
Intervalle = Now + TimeValue("00:00:01")
 
Application.OnTime Intervalle, "ChangeTextbox"
 
Acceuil.TextBox_English.Value = Worksheets("Feuil2").Range("A" & I)
Acceuil.TextBox_Français.Value = Worksheets("Feuil2").Range("B" & I)
 
    If I = Worksheets("Feuil2").Range("A1:A250").End(xlDown).Row Then
 
        Application.OnTime Intervalle, "ChangeTextbox", Schedule:=False
        Debug.Print "toto"
    End If
 
End Sub

En tête de module :

Code:

Public I As Long 'au lieu de Ctr

Dans le code du userform :

Code:

1
2
3
4
'au lieu de Private Sub CommandButton1_Click()
Private Sub CommandButton_Démarrage_Click()
Call test
End Sub

pardon pour l'oubli 'au lieu de Private Sub CommandButton1_Click()

Ce que j'ai modifié :

I = 0 quand on clique sur le bouton démarrage pour repartir de 0
Application.OnTime Now, "ChangeTextbox" au lieu de Application.OnTime Now + TimeValue("00:00:01"), "ChangeTextbox"

Ce que j'ai ajouté :

Une combobox "ComboBox_Temps" qui peut prendre la valeur 1 2 ou 3 (temps d'attente entre deux mots) Variable K
bloquer les boutons lors de l'exécution de la procédure

Je pense que cela fonctionne ^^
http://www.partage-fichiers.com/upload/3ipl7la2

Pièce jointe 169038

Userform :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Private Sub UserForm_Initialize()
 
'Valeur temps par défaut
ComboBox_Temps.Value = 1
 
End Sub
 
Private Sub CommandButton_Démarrage_Click()
 
' Bloque le bouton, combobox et texbox
 
CommandButton_Démarrage.Locked = True
ComboBox_Temps.Locked = True
Acceuil.TextBox_English.Locked = True
Acceuil.TextBox_Français.Locked = True
 
'Initialisation du compteur I et Valeur de temps d'attente J
I = 0
J = ComboBox_Temps.Value
 
'Appel la procédure test
Call test
 
End Sub

Module

Code:

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
Public I As Long
Public J As Byte
Public K As Variant
Sub ouverture()
 
'Ouverture userform
Acceuil.Show
 
End Sub
 
Sub ChangeTextbox()
 
Dim Intervalle As Variant
 
I = I + 1
Intervalle = Now + K
 
Application.OnTime Intervalle, "ChangeTextbox"
 
Acceuil.TextBox_English.Value = Worksheets("Feuil2").Range("A" & I)
Acceuil.TextBox_Français.Value = Worksheets("Feuil2").Range("B" & I)
 
    If I = Worksheets("Feuil2").Range("A1:A250").End(xlDown).Row + 1 Then
 
        Application.OnTime Intervalle, "ChangeTextbox", Schedule:=False
        Debug.Print "toto"
 
        ' Débloque le bouton, combobox et texbox
        Acceuil.CommandButton_Démarrage.Locked = False
        Acceuil.ComboBox_Temps.Locked = False
        Acceuil.TextBox_English.Locked = False
        Acceuil.TextBox_Français.Locked = False
    End If
 
End Sub
 
Sub test()
 
' Sectionne le temps d'attente selon la valeur J (Valeur de la combobox)
Select Case J
Case 1
K = TimeValue("00:00:01")
Case 2
K = TimeValue("00:00:02")
Case 3
K = TimeValue("00:00:03")
End Select
 
Application.OnTime Now, "ChangeTextbox"
 
End Sub

Encore Merci