Anzeige
Archiv - Navigation
332to336
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
332to336
332to336
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Wie binde ich die Progressbar in mein Macro ein?

Wie binde ich die Progressbar in mein Macro ein?
04.11.2003 07:48:30
Fritz
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

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Wie binde ich die Progressbar in mein Macro ein?
04.11.2003 10:03:26
xXx
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
Anzeige
Perfekt, danke vielmals für deine Hilfe o.T.
04.11.2003 11:09:28
Fritz
oT

303 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige