Progress Bar au premier plan

**ropineau** · 23/03/2008, 14h28

Pendant que j'y suis, j'ai une autre question.

Bonjour,

Je suis en train de faire une progress bar.

J'ai cree cette progressbar dans un UF et je l'implante au fur et a mesure qu'une autre macro tourne.

Le probleme est que mon userform ne s'affiche que quand mon autre macro a finie de tourner (ce qui fait qu'il ne s'affiche que quand il est a 100%

)

Comment faire pour le laisser a l'ecran tout le temps ?

Voila la macro de mon UF

Code :

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

1
2
3
4
5
6
7
8
9
Private Sub UserForm_Initialize()
    With Me.ProgressBar1
        .Min = 0
        .Max = Sheets("Calcul").Cells(12, 2).Value
        .Value = 0
    End With
UFProgressBar
Sheets("Database").Import
End Sub

Et voici l'autre macro qui tourne

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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
Sub Import()
 
On Error GoTo line10
 
Max = Sheets("AccountDetails").Cells(1, 1).CurrentRegion.Rows.Count
 
Sheets("Database").Columns("A:A").NumberFormat = "@"
Sheets("Database").Columns("Q:Q").NumberFormat = "yyyy-mm-dd"
 
For a = 2 To Sheets("AccountDetails").Cells(1, 1).CurrentRegion.Rows.Count
    If Sheets("Database").Cells(1, 1).CurrentRegion.Rows.Count = 1 Then
        Sheets("AccountDetails").Cells(a, 6).Value = "'" & Sheets("AccountDetails").Cells(a, 6).Value
        Sheets("Database").Cells(2, 1).Value = Sheets("AccountDetails").Cells(a, 6).Value
        b = 2
        GoTo line1
    End If
    For b = 2 To Sheets("Database").Cells(1, 1).CurrentRegion.Rows.Count
        Sheets("AccountDetails").Cells(a, 6).Value = "'" & Sheets("AccountDetails").Cells(a, 6).Value
        If (Sheets("Database").Cells(b, 1).Value = Sheets("AccountDetails").Cells(a, 6).Value) And Sheets("Database").Cells(b, 2) <> "" Then
            GoTo line1
        ElseIf (Sheets("Database").Cells(b, 1).Value > Sheets("AccountDetails").Cells(a, 6).Value) Then
            Sheets("Database").Rows(b).Insert Shift:=xlDown
            Sheets("Database").Cells(b, 1).Value = Sheets("AccountDetails").Cells(a, 6).Value
            GoTo line1
        ElseIf Sheets("Database").Cells(b + 1, 1).Value = "" Then
            b = b + 1
            Sheets("Database").Cells(b, 1).Value = Sheets("AccountDetails").Cells(a, 6).Value
            GoTo line1
        Else:
            GoTo line2
        End If
line1:
        For c = 1 To 5
            Sheets("Database").Cells(b, c + 2).Value = Sheets("AccountDetails").Cells(a, c).Value
        Next c
        Sheets("Database").Cells(b, 8).Value = Sheets("AccountDetails").Cells(a, 7).Value
        Sheets("Database").Cells(b, 2).Value = Sheets("AccountDetails").Cells(a, 8).Value
        For c = 9 To 17
            Sheets("Database").Cells(b, c).Value = Sheets("AccountDetails").Cells(a, c).Value
        Next c
        GoTo line3
line2:
    Next b
line3:
 
If UFProgressBar.ProgressBar1.Value = Max Then
    Unload UFProgressBar
    Exit Sub
Else
    UFProgressBar.ProgressBar1.Value = UFProgressBar.ProgressBar1.Value + 1
End If
 
 
Next a
 
For d = 2 To Sheets("Database").Cells(1, 1).CurrentRegion.Rows.Count
    If Sheets("Database").Cells(d, 10).Value = Sheets("Database").Cells(d, 11).Value Then
        Sheets("Database").Cells(d, 18).Value = 1
    Else:
        y = Sheets("Database").Cells(d, 1).Value
        v = Sheets("Database").Cells(d, 11).Value
        w = Sheets("Database").Cells(d, 10).Value
        x = InputBox("Account number : " & y & Chr(10) & Chr(10) & "The customer base currency is different than the account currency" & Chr(10) & Chr(10) & "Customer Base Currency :" & w & Chr(10) & "Account Currency : " & v & Chr(10) & Chr(10) & "Please enter bellow the accounting rate", "Accounting rate")
        Sheets("Database").Cells(d, 18).Value = x
    End If
Next d
 
Sheets("Main menu").Range("H7:J500").ClearContents
Sheets("Main menu").Range("H7:J7").Merge
Sheets("Main menu").Range("H7:J7").HorizontalAlignment = xlCenter
Sheets("Main menu").Range("H7:J7").Font.Bold = True
Sheets("Main menu").Range("H9").Font.Underline = xlUnderlineStyleSingle
Sheets("Main menu").Cells(7, 8).Value = "Import report"
Sheets("Main menu").Cells(9, 8).Value = "Successful"
Exit Sub
line10:
Sheets("Main menu").Range("H7:J500").ClearContents
Sheets("Main menu").Range("H7:J7").Merge
Sheets("Main menu").Range("H7:J7").HorizontalAlignment = xlCenter
Sheets("Main menu").Range("H7:J7").Font.Bold = True
Sheets("Main menu").Range("H9").Font.Underline = xlUnderlineStyleSingle
Sheets("Main menu").Cells(7, 8).Value = "Import report"
Sheets("Main menu").Cells(9, 8).Value = "Failure"
 
End Sub