Display Status Bar
26.04.2005 10:23:57
Norbert
bin mit einem Code am arbeiten, der mir doppelte Einträge farbig markiert und der auch funktioniert. Da ich und andere Kollegen sehr lange Softwarelisten zu bearbeiten haben, entschloss ich mich einen Status mit anzeigen zu lassen.
(Excel tut eine Weile nichts, man könnte meinen das Excel hängt)
Dazu fand ich ein Script auf Herbers Server, habe auch schon einiges versucht, komme aber nicht richtig vorwärts. Es sollte also in der Statusbar angezeigt werden, wie weit Excel den Prozess (doppelte Einträge suchen)abgearbeitet hat,
damit auch erkannt wird, dass Excel noch was tut.
Hier mal das Script doppelte Einträge suchen und das was ich zum Thema Statusbar fand. Wichtig ist auch, es können keine zusätzlichen Verweise oder Laufzeitumgebungen eingebunden werden!
Sub finden()
Dim iRow As Integer, iRowL As Integer, iCounter As Integer
iRowL = Cells(Cells.Rows.Count, 2).End(xlUp).Row
For iRow = iRowL To 1 Step -1
If WorksheetFunction.CountIf(Columns(1), Cells(iRow, 1)) > 1 Then
Rows(iRow).Columns(1).Interior.ColorIndex = 33
End If
Next iRow
Code vom Excelsever:
'In Klassenmodul einfügen
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.DisplayStatusBar = bln
End Sub
Private Sub Workbook_Open()
bln = Application.DisplayStatusBar
Application.DisplayStatusBar = True
End Sub
'In Modul einfügen
Public bln As Boolean
Sub Fortschritt()
Dim iCounter As Integer
Application.DisplayStatusBar = True
For iCounter = 1 To 10
StatusLED "schon geschafft: ", iCounter / 10
Application.Wait Now + TimeSerial(0, 0, 1)
Next iCounter
Application.StatusBar = False
End Sub
Private Function StatusLED(sMsg As String, sPct As Single)
Dim iPct As Integer, iReps As Integer
With WorksheetFunction
iPct = .Round(sPct, 2) * 100
iReps = Int(iPct / 10)
Application.StatusBar = sMsg & .Rept(Chr(14), iReps) & .Rept("*", 10 - iReps) & " " & iPct & "%"
End With
End Function
Kann man dies so hinbekommen, dass anstelle eines Count's, der Fortschritt des "Finden" - Macros angezeigt wird?
Vielen Dank vorab, für Eure Bemühungen!
Gruß Norbert.