Herbers Excel-Forum - das Archiv

Bewerten Sie hier bitte das Excel-Portal

Wie binde ich die Progressbar in mein Macro ein?

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
⇒ UserForm
Bild

Betrifft: Wie binde ich die Progressbar in mein Macro ein?
von: Fritz
Geschrieben am: 04.11.2003 07:48:30
Hallo liebe Experten,

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
Bild

Betrifft: AW: Wie binde ich die Progressbar in mein Macro ein?
von: xXx
Geschrieben am: 04.11.2003 10:03:26
Hallo,
etwa so:



Private Sub UserForm_Activate()
Call Vergleich
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


'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

Max = WS2.Range("Q65536").End(xlUp).Row

For iZeile = 3 To Max
uf_ProgBar.PBx.Width = uf_ProgBar.PB100.Width / Max * iZeile
uf_ProgBar.Caption = "Programmfortschritt " & Int(iZeile / Max * 100) & "%"
DoEvents

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

Gruß aus'm Pott
Udo
Bild

Betrifft: Perfekt, danke vielmals für deine Hilfe o.T.
von: Fritz
Geschrieben am: 04.11.2003 11:09:28
oT
Bild