Fortschrittsanzeige / Ergänzung
03.01.2004 10:32:12
Erich M.
bei meinem alten Thread komme ich nicht mehr weiter; ferner
habe ich doch noch was gefunden; zunächst nochmals das Problem:
Ich habe ein Makro erstellt, mit dem Daten aus einer anderen Datei
in die aktuell geöffnete Datei importiert werden. Da die Daten sehr
umfangreich sind, dauert das mittlerweile doch ziemlich lange. Mit
Verwendung "Application.ScreenUpdating" sieht der User nicht was alles abläuft.
Nun bin ich auf der Suche nach einer Zusatzinfo die evtl. eingeblendet
wird und den User nicht beunruhigt. Ich dachte an einen "Fortschrittsbalken"
o.ä. - das Muster auf Hajo's Seite kann ich leider nicht verwenden.
Ich weiss aber nicht ob das überhaupt geht, denn zunächst müsste das Makro
abschätzen wie lange es überhaupt Zeit braucht, damit es dann anzeigen kann,
wieviel Zeit bereits verbraucht ist.
alter Thread mit Musterdatei:
https://www.herber.de/forum/archiv/356to360/t357424.htm
jetzt habe ich noch folgenden Code gefunden:
Option Explicit
Sub StartProcessing1()
' displays a progress bar while a macro runs, requires a reference to MSCOMCTRL.OCX
Dim lngTotal As Long, lngI As Long
' initiate progressbar
Load frmProgressBar1
With frmProgressBar1
.ProgressBar1.Scrolling = ccScrollingStandard ' or ccScrollingSmooth
.Show ' set the UserForms ShowModal property to false before running
' or .Show False
End With
UpdateProgressBar1 0, "Processing..." ' set initial progress status
' start the process
lngTotal = 2000
For lngI = 1 To lngTotal
If lngI Mod 50 = 0 Then ' update the progressbar for every 50th loop
UpdateProgressBar1 lngI / lngTotal * 100, "Processing " & Format(lngI / lngTotal, "0%") & "..."
End If
' do something, place your code here
Range("C1").Formula = Format(Time, "hh:mm:ss")
Next lngI
Range("C1").ClearContents
' clean up
frmProgressBar1.Hide
Unload frmProgressBar1
End Sub
Private Sub UpdateProgressBar1(NewValue As Single, Optional NewCaption As String)
' updates the progressbar dialog
With frmProgressBar1
If Not IsMissing(NewCaption) Then .Caption = NewCaption
.ProgressBar1.Value = NewValue
If NewValue = 0 Then .Repaint
End With
End Sub
Code eingefügt mit: Excel Code Jeanie
Allerdings ist mir noch unklar, wie ich in der Zeile 'do something.....
mein eigenes Makro, das über einen Button aufgerufen wird, starten kann??
Jetzt wird's wohl langsam unübersichtlich, aber ich gebe nicht auf;
das Forum ist immer wieder für Überraschungen und geniale Ideen gut.
Besten Dank für eine Hilfe!
mfg
Erich