UserForm avec textes variables

Bonjour,

Dans le fichier ci-joint, j’ai tenté de faire apparaître un UserForm indiquant l’avancement de la macro. Selon les étapes, ça affiche Texte 1 ou 2. Dans mon fichier réel, j’aurai 5 à 6 étapes en tout.

Dans ce fichier modèle, si j’indique de traiter 20'000 lignes, ça fonctionne assez bien sur ma machine, le UserForm indique les textes désirés.

Si je traite disons 50'000 lignes par contre, ça ne va plus, j’ai durant un certain moment le texte ‘’UserForm1 ne répond pas’’ qui apparait.

Savez-vous comment résoudre ce problème ?

De plus, savez-vous comment faire disparaitre la croix blanche sur fond rouge (mais c’est presque un drapeau suisse ça ) du UserForm visible à l’écran ?

Voici mon code actuel :

Sub rr()

Application.ScreenUpdating = False

xx = InputBox("Combien de cellules doivent être modifiées ? Par exemple 50'000 c'est pas mal.")

UserForm1.Show vbModeless
UserForm1.Label1.Caption = "Texte 1"
UserForm1.Repaint

For i = 1 To xx
   Cells(i, 1) = Rnd
Next i

UserForm1.Label1.Caption = "Texte 2"
UserForm1.Repaint

For i = 1 To xx
   Cells(i, 2) = Rnd
Next i

Unload UserForm1

End Sub

Cordialement.

Bonjour,

Pour info il n'y a pas de fichier joint.

Cordialement,

Vbabeginner

Aie, erreur de débutant ! Merci de m'en avoir averti.

Je suis en voyage et ne pourrais pas ajouter le fichier manquant. Mais en fait, dans mon fichier il n'y a rien d'autre que la macro fournie ci- dessus et un bouton pour la lancer !

Si jamais je joindrai ce fichier au plus vite.

Amicalement

Bonjour,

A tester.

Pour ma part, c'est presque instantané.

Cdlt.

Option Explicit

Sub rr()
Dim ws As Worksheet
Dim xx As Long, I As Long
'Dim modeCalc As XlCalculation
Dim arr() As Double

    With Application
        'modeCalc = .Calculation
        '.Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    Set ws = ActiveWorkbook.Worksheets(1)

    xx = InputBox("Combien de cellules doivent être modifiées ? Par exemple 50'000 c'est pas mal.")

    With UserForm1
        .Show vbModeless
        .Label1.Caption = "Texte 1"
        .Repaint
    End With

    'For I = 1 To xx
        'ActiveSheet.Cells(I, 1) = Rnd
    'Next I

    ReDim arr(1 To xx)
    For I = 1 To xx
        arr(I) = Rnd
    Next
    ws.Cells(1).Resize(UBound(arr)).Value = arr
    Erase arr()

    With UserForm1
        .Label1.Caption = "Texte 2"
        .Repaint
    End With

    'For I = 1 To xx
        'ActiveSheet.Cells(I, 2) = Rnd
    'Next I

    ReDim arr(1 To xx)
    For I = 1 To xx
        arr(I) = Rnd
    Next
    ws.Cells(2).Resize(UBound(arr)).Value = arr

    'Application.Calculation = modeCalc

    Unload UserForm1

    Erase arr()
    Set ws = Nothing

End Sub

Salut,

Merci pour ta réponse, mais mes boucles sans fin étaient jute destinées à démontrer mon autre problème au sujet de l'affichage des UserForm ; il ne fallait donc pas remplacer cette parti du code !

Quelqu'un à une solution à mon problème d'affichage ?

Chaleureusement

Bonjour Yvouille,

Ci-joint un exemple que je l'utilise depuis des années pour les traitements longs. Utilisation très simple.

A voir si cela correspond à ton besoin.

Bonne journée

Bouben

Bonjour,

il m'a fallu beaucoup plus de boucles pour avoir l'erreur. Sans doute que la mémoire dispo joue un rôle.

Le laisser faire ce qu'il a à faire de temps en temps. Ajouter dans les boucles :

If i Mod 1000 = 0 Then DoEvents

eric

Re,

Donc essaie ainsi.

J'avais ton souci avant. Le fait de déclarer les variables et mettre le calcul en manuel, a résolu le souci.

Option Explicit

Sub rr()
Dim ws As Worksheet
Dim xx As Long, I As Long
Dim modeCalc As XlCalculation

    With Application
        modeCalc = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    Set ws = ActiveWorkbook.Worksheets(1)
    xx = InputBox("Combien de cellules doivent être modifiées ? Par exemple 50'000 c'est pas mal.")

    With UserForm1
        .Show vbModeless
        .Label1.Caption = "Texte 1"
        .Repaint
    End With

    For I = 1 To xx
        ActiveSheet.Cells(I, 1) = Rnd
    Next I

    With UserForm1
        .Label1.Caption = "Texte 2"
        .Repaint
    End With

    For I = 1 To xx
        ActiveSheet.Cells(I, 2) = Rnd
    Next I

    Application.Calculation = modeCalc

    Unload UserForm1

    Set ws = Nothing

End Sub

Bonjour et merci pour vos nombreuses réponses.

@ Bouben

J’avais bien pensé aux ProgressBar, mais avec 5 ou 6 étapes de longueur différente, ça risque d’être un peu lourd à la lecture à l'écran. Je trouvais qu’une simple information de l’avancement étape par étape était suffisante. A voir par la suite si pour une étape particulièrement longue, ça vaudrait quand même la peine d’avoir une ProgressBar. Mais à la base ma question concernait vraiment l’avancement des étapes uniquement.

@ Jean-Eric

Si je lance une boucle pour un très grand nombre de lignes, le UserForm montrant le deuxième texte continue de m’indiquer au bout d’un moment ‘’UserForm1 ne répond pas’’.

@ eriiicTa solution semble fonctionner parfaitement, en tout cas pour un nombre de lignes raisonnable (jusqu’à 300'000, soit environ une durée d’affichage de 30 secondes par texte sur ma machine). Je pense que ça sera tout à fait possible d’appliquer ta solution à mon fichier réel. Un merci tout particulier à ton attention.

@ Tous

Personne ne s’est intéressé à mon problème de croix blanche. Pour mémoire ma demande :

Yvouille a écrit :

De plus, savez-vous comment faire disparaitre la croix blanche sur fond rouge (mais c’est presque un drapeau suisse ça ) du UserForm visible à l’écran ?

Cordialement.

Bonjour,

Un lien qui pourra peut-être répondre à ta question de la croix.

Cdlt.

https://forum.excel-pratique.com/excel/suprimer-la-croix-rouge-sur-une-userform-t28434.html

Encore une fois merci pour toutes vos solutions

Très bonne soirée.

Rechercher des sujets similaires à "userform textes variables"