Wie binde ich die Progressbar in mein Macro ein?
04.11.2003 07:48:30
Fritz
ich möchte gerne die Excelerator Progressbar in mein Macro einbinden, was muß ich da genau ändern?
Das Formular UF-Progbar habe ich bereits rüberkopiert, die anderen nötigen MAcros auch, aber wie genau muß ich die diversen Macros jetzt ändern damit die Progressbar auch richtig anzeigt?
MACROS AUS DER PROGRESSBAR:
Private Sub UserForm_Activate()
Makro1
Unload Me
End Sub
Private Sub UserForm_Initialize()
Me.PBx.Width = 0
End Sub
Private Sub cb_Start_Click()
Start
End Sub
Public Max As Long, i As Long
Sub Start()
Load uf_ProgBar
uf_ProgBar.Show
DoEvents
End Sub
Sub Makro1()
Max = 2000
For i = 1 To Max
Sheets(1).Cells(1, 1) = i
uf_ProgBar.PBx.Width = uf_ProgBar.PB100.Width / Max * i
uf_ProgBar.Caption = "Programmfortschritt " & Int(i / Max * 100) & "%"
DoEvents
Next
End Sub
MEIN MACRO in das die Progressbar eingebunden werden soll:
Sub Vergleich()
Dim WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet
Dim iZeile As Long, Zelle As Range, LetzteZeile As Long, Tage%
Dim N%, i%, Ausg()
Application.ScreenUpdating = False
Set WS1 = Worksheets("Berechnung")
Set WS2 = Worksheets("Eingang")
Set WS3 = Worksheets("Ausgang")
N = WS3.Range("L65536").End(xlUp).Row - 2
ReDim Ausg(1 To N, 1 To 2)
For i = 1 To N
Ausg(i, 1) = WS3.Cells(i + 2, 12) 'Lagereinheit
Ausg(i, 2) = WS3.Cells(i + 2, 25) 'Datum
Next i
WS1.Range("A2:E65536").ClearContents
For iZeile = 3 To WS2.Range("Q65536").End(xlUp).Row
For i = 1 To N
If Ausg(i, 1) = WS2.Cells(iZeile, 17) Then
Tage = Ausg(i, 2) - WS2.Cells(iZeile, 25) + 1
If Tage > 0 Then Exit For
End If
Next i
LetzteZeile = WS1.Range("A65536").End(xlUp).Row + 1
If i > N Then
WS1.Cells(LetzteZeile, 1) = WS2.Cells(iZeile, 17)
WS1.Cells(LetzteZeile, 2) = "Noch kein Ausgang"
Else
WS1.Cells(LetzteZeile, 1) = Ausg(i, 1)
WS1.Cells(LetzteZeile, 2) = Tage
Ausg(i, 2) = DateSerial(2000, 1, 1)
End If
WS1.Cells(LetzteZeile, 3) = WS2.Cells(iZeile, 6)
WS1.Cells(LetzteZeile, 4) = WS2.Cells(iZeile, 7)
WS1.Cells(LetzteZeile, 5) = WS2.Cells(iZeile, 25)
Next iZeile
Application.ScreenUpdating = True
End Sub
Vielen Dank für alle Tipps
Gruß Fritz
Anzeige