Problemstellung:
Für 32Bit und 64Bit Office Versionen
Wie kann ich in der Statuszeile eines Formulars ein Progressbar darstellen?
Fast jeder stand schon mal vor der Situation ein Progressbar darstellen zu wollen.
Jetzt gibt es da einige Lösungen ob nun mit ActiveX-Controls oder anders.
Am einfachsten geht es mit dem SysCmd-Objekt.
Lösung:
Das SysCmd-Objekt hat 3 Methoden dafür.
acSysCmdInitMeter zur Initialisierung der Progressbar
acSysCmdUpdateMeter zur Aktualisierung der Progressbar
acSysCmdRemoveMeter zum Löschen der Progressbar
1. Initialisierung der Pogressbar:
Dim RetVal As Variant RetVal = SysCmd(acSysCmdInitMeter, "Statuszeilentext", die Obergrenze)
2. Aktualisierung der Pogressbar:
For n = 1 To 10000000 RetVal = SysCmd(acSysCmdUpdateMeter, n) Next n
3. Löschen der Pogressbar:
RetVal = SysCmd(acSysCmdRemoveMeter)
Hier ein konkretes Beispiel:
Sub Import(sFile As String) Dim rsIn As DAO.Recordset, rsOut As DAO.Recordset Dim RetVal As Variant, nCount As Long, n As Long Dim sInArt As String DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel9, "Material", sFile, True Set rsIn = CurrentDb.OpenRecordset("Material") Set rsOut = CurrentDb.OpenRecordset("tblArtikel") '************************************************************ 'Progressbar initialisieren rsIn.MoveLast nCount = rsIn.RecordCount rsIn.MoveFirst RetVal = SysCmd(acSysCmdInitMeter, "Datenimport...", nCount) '************************************************************ Do While Not rsIn.EOF sInArt = rsIn!Artikel rsOut.FindFirst "Artikel = '" & sInArt & "'" If rsOut.NoMatch = True Then rsOut.AddNew rsOut!Artikel = rsIn!Artikel rsOut.Update Else rsOut.Edit rsOut!Bezeichnung = rsIn!Bezeichnung rsOut.Update End If rsIn.MoveNext rsOut.MoveFirst '************************************************************ 'Progressbar aktualisieren n = n + 1 RetVal = SysCmd(acSysCmdUpdateMeter, n) '************************************************************ CurrentDb.TableDefs.Delete "Material" Loop rsIn.Close: Set rsIn = Nothing rsOut.Close: Set rsOut = Nothing '************************************************************ 'Progressbar löschen RetVal = SysCmd(acSysCmdRemoveMeter) MsgBox "Datenimport beendet!", vbInformation + vbOKOnly, "Erfolg" '************************************************************ End Sub
Ergebnis:
Ähnliche Artikel
Weiterlesen...