Live-Forum - Die aktuellen Beiträge
Datum
Titel
26.04.2024 12:46:38
Nutzereingaben Speichern und Laden
26.04.2024 11:49:48
VAB und Bedingte Formatierung nimmt die Farbe im Makro nicht
26.04.2024 11:38:46
Acrobat PDF Formularfelder mit Excel ausfüllen
26.04.2024 11:23:04
zählen wenn - aber nur die selektierten Zeilen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1804to1808
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1804to1808
1804to1808
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

ProgressBar

ProgressBar
07.01.2021 15:15:14
Steve
Hallo Leute,
wieder einmal kam mir eine brilliante Idee bei der ich von der Umsetzung keinen Schimmer habe. Das hält mich natürlich nicht auf und deshalb hab ich mal recherchiert.
Ich möchte, da mein Makro lange läuft und dem einen ode anderen User glauben macht es sei abgestürzt, eine Progressbar einbauen. Hab so ein Ding auch gefunden und weitgehend verstanden. Was ich aber nirgends im Netz finde ist wie ich das verwende. Also baue ich meinen eigentlichen Code in den Progress-Bar-Code ein, lasse ich den parallel laufen....
Ich habe da eine Idee und würde gerne wissen ob ich damit auf dem Holzweg bin. Vielleicht kann mir da jemand mit einem Tipp helfen.
Mein Makro listet im wesentlichen alle Dateien aus einem Ordner auf.
Das sieht dann so aus:
Sub steht da nur zur besseren abgrenzung
For Each objDatei In objDateienliste
If Not objDatei Is Nothing Then
ActiveSheet.Cells(lngZeile, 3) = objDatei.Name
ActiveSheet.Hyperlinks.Add Anchor:=Cells(lngZeile, 3), Address:=objDatei
ActiveSheet.Cells(lngZeile, 8) = objDatei
ActiveSheet.Cells(lngZeile, 2) = objVerzeichnis.Path
ActiveSheet.Hyperlinks.Add Anchor:=Cells(lngZeile, 2), Address:=objVerzeichnis,  _
TextToDisplay:=objVerzeichnis.Name
lngZeile = lngZeile + 1
End If
Next objDatei
Call UnterOrdnerAuslesen(objVerzeichnis)
Call SVERWEIS_Vlookup
Call Nummerierung
End Sub
und hier das Makro für die Progress-Bar; 
Sub Progressbar1()
SW = 3005
Länge = 0
Schritt = PB1.Label1.Width / SW
For i = 5 To SW
Cells(i, 1) = "TEST " & i
Cells(i, 1).Interior.ColorIndex = 6
Länge = Länge + Schritt
PB1.Label2.Width = Länge
PB1.Label3.Caption = Format(i / SW, "0 %")
DoEvents
Next
Application.Wait (Now + TimeValue("0:00:2"))
Unload PB1
End Sub
Meine Idee wäre den Progress code um mein Ordnerauslesen herumzubauen. Also meinen code da einzubauen wo jetzt folgendes steht:
Cells(i, 1) = "TEST " & i
Cells(i, 1).Interior.ColorIndex = 6
Liege ich damit richtig? Kann mir das jemand sagen?
Wenn nicht, kann mir jemand sagen wie ich das richtig einbinde? Gerne auch was zum nachlesen. Wie gesagt, ich habe Progressbars gefunden, aber keine Anleitung wie man sie einbindet, also wo und wie der eigentliche Code steht bzw. abläuft.
Liebe Grüße
Steve

35
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: ProgressBar
07.01.2021 15:31:27
onur
Genau anders herum - Progressbar muss IN die Schleife integriert werden und der aktuelle Fortschritt muss der index der Schleife sein.
Deswegen muss auch der Maximalwert der Schleife von Anfang an feststehen (woher soll der Progressbar sonst wissen, wieviel % schon erledigt sind ?) - daher keine For-Each oder Do-While-Schleifen.
AW: ProgressBar
07.01.2021 15:38:55
Daniel
Nicht unbedingt.
Man muss halt, wenn man die Progressbar haben will, die Anzahl der Durchläufe vorher ermitteln und dann selber den Zähler mitlaufen lassen.
Bei For-Each-Schleifen geht das in der Regel mit .Count, bei Do-Loop hängt es vom Einzelfall ab.
Im Zweifelsfall kann man die Schleife auch vorher ohne Aktion durchlaufen lassen, um die Anzahl zu ermitteln (macht natürlich nur Sinn, wenn das schnell genug geht)
Gruß Daniel
Anzeige
AW: ProgressBar
07.01.2021 15:40:44
onur
"Nicht unbedingt." - ich weiss, aber ich wollte keine Anfänger überfordern.
AW: ProgressBar
07.01.2021 15:43:12
Steve
Das Ende der Liste:
Also ich hab mir das so überlegt. Das Ende der Liste ist die Menge aller Dateien die sich in dem auszulesenden Ordner samt unterordner befindet. Ich weiss zwar noch nicht wie, aber ich dachte mir, das dies relativ leicht mit einem Makro zu ermitteln ist.
Dann wüsste ich das MAX. - sehe ich das richtig?
Gruß Steve
AW: ProgressBar
07.01.2021 15:48:14
Daniel
Richtig
AW: ProgressBar
07.01.2021 15:57:10
Steve
Danke
AW: ProgressBar
07.01.2021 15:33:00
Daniel
Progressbar geht so
1. Userform anlegen mit der Progressbar
2. im eigenen Code zu Beginn die Userform nicht-modal aufrufen
3. innerhalb der Schleife dann den .Value-Wert der Progressbar erhöhen um den Fortschritt anzuzeigen.
Ggf muss die Anzeige der Userform mit .Repaint aktualisiert werden.
Bei welchen Werten die Progressbar leer bzw voll ist, legst du über die Eigenschaften Min und Max fest.
Ich bin mir aber ziemlich sicher, dass dieses Vorgehen bereits beschrieben wurde, schau dir deine Recherche-Ergebnisse nochmal genauer an.
Gruß Daniel
Anzeige
AW: ProgressBar
07.01.2021 15:40:07
Steve
Moin Daniel,
das musste ich zweimal lesen...aber ich glaube ich habe dich verstanden. Ich starte mit meinem ursprünglichem Makro einfach die Userform mit und die läuft dann parallel?
Steve
AW: ProgressBar
07.01.2021 15:44:50
Daniel
Ja, sofern sie nicht-modal ist.
Verwendet du die Userform modal, dann wartet das Makro bis die Userform wieder geschlossen wird und dann funktioniert das nicht.
Gruß Daniel
AW: ProgressBar
07.01.2021 15:48:52
Steve
Modal - sperrt den Rest der Anwendung
nichtmodal - lässt Eingaben außerhalb des Dialog zu
Das musste ich nachlesen. Aber wie finde ich heraus was ich benutze.
Gruß Steve
AW: ProgressBar
07.01.2021 15:54:14
onur
Modal:
Userform1.Show
Nicht-Modal:
Userform1.Show vbModeless
Muss nur NonModal sein, wenn der Progressbar immer offen bleibt und dein Code durch ihn aufgerufen wird.
Aber wenn du es so machst wie in der von mir geposteten Datei (Der Progressbar wird von der Schleife aufgerufen), dann ist es egal.
Anzeige
AW: ProgressBar
07.01.2021 16:00:39
ralf_b
alternativ könntest du einfach den aktuellen Dateinamen(oder jeden 10ten) in die Statuszeile von Excel schreiben.
Und warum läuft dein Makro so lange? Vielleicht läßt sich daran ja auch was ändern.
gruß
rb
AW: ProgressBar
07.01.2021 16:06:28
Steve
Moin Ralf,
das erste habe ich nicht verstanden.
Ich beschreibe kurz was mein Makro macht. Es liest alle Dateien aus, legt eine Liste an (eine Spalte Ordner, eine Spalte Dateien), Hyperlinkt diese Liste mit den Ordner, bzw. Dateien und hinterlegt in der letzen Spalte (bisher sicherheitshalber) den Pfad
Damit habe ich eine Liste aller Dateien in meinem Archiv und kann die bequem - mit einem doppelklic-event - umbenennen
oder filtern
Steve
Anzeige
AW: ProgressBar
07.01.2021 15:55:05
Steve
Hallo Onur,
ich danke dir. Vor allem für die Erläuterungen.
tot = 10000 ' Anzahl der Durchläufe muss VORHER feststehen
Hier muss dann die von mir vorher ermittelte Zahl (als definierten Wert) stehen der zuvor ausgelesen hat wieviele Dateien sich im Ordner samt unterordner befindet. Korrekt?
Steve
Anzeige
AW: ProgressBar
07.01.2021 15:58:07
onur
Bei einer Range würde ich das so machen: 
MAX= Range("A1:ZZ300").Cells.Count
For Each cell in Range("A1:ZZ300")
Next

AW: ProgressBar
07.01.2021 16:02:20
Steve
Die Menge der Dateien ändert sich ja beständig. Aus diesem Grund würde ich ein Makro vorneweg laufen lassen. Das würde die Menge der Dateien zählen und den Wert als Variable weitergeben.
dim M as string
tot = M
so ungefähr.
Steve
AW: ProgressBar
07.01.2021 16:05:20
onur
objDateienListe ist doch ein Array - oder?
Also: 
Max=ubound(objDateienListe)

AW: ProgressBar
07.01.2021 16:13:38
Steve
Das werde ich austesten. Allerdings muss ich jetzt das Kind abholen. Ich berichte Morgen ob das klappt.
Ich glaube aber das es nicht alle Sind, da ja die Dateien der Unterordner da nicht drin sind.
Oder ich hab einen Denkfehler.
Ich werde mich heute Abend wieder dransetzen und die beiden Makros kombinieren.
Dann sende ich das Ergebnis. Falls du Zeit hast, würden mich Verbesserungsvorschläge sehr interessieren.
Danke euch allen.
Steve
Anzeige
besser ist doch,
07.01.2021 16:32:34
Rudi
Hallo,
das ganze zu beschleunigen, anstatt durch die PB zusätzlich auszubremsen.
z.B. 
Option Explicit
Dim FSO As Object
Sub DateiListe()
Dim oFolder As Object, oDictF As Object
Dim strFolder As String, arrHeader, wksListe As Worksheet
Dim lngColumns As Long
Dim arrItems, arrOut, i As Integer, j As Integer
Dim t
Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Ordner wählen"
.AllowMultiSelect = False
If .Show = -1 Then
strFolder = .SelectedItems(1)
End If
End With
If strFolder = "" Then Exit Sub
t = Timer
Set FSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = FSO.GetFolder(strFolder)
Set oDictF = CreateObject("Scripting.dictionary")
arrHeader = Array("Name", "Ext", "Ordner", "kB", "le.Änd.", "Erstellt", "Pfad", "Link")
lngColumns = UBound(arrHeader) + 1
prcFiles oFolder, oDictF
prcSubFolders oFolder, oDictF
On Error Resume Next
Set wksListe = ThisWorkbook.Sheets("DateiListe")
On Error GoTo 0
If wksListe Is Nothing Then
Set wksListe = Worksheets.Add(before:=Sheets(1))
wksListe.Name = "DateiListe"
End If
With wksListe
.Cells.Clear
.Cells(1, 1).Resize(, lngColumns) = arrHeader
.Cells(1, 1).Resize(, lngColumns).Font.Bold = True
If oDictF.Count > 0 Then
arrItems = oDictF.items
ReDim arrOut(1 To oDictF.Count, 1 To lngColumns)
For i = 0 To UBound(arrItems)
For j = 0 To UBound(arrItems(i))
arrOut(i + 1, j + 1) = arrItems(i)(j)
Next j
Next i
.Cells(2, 1).Resize(UBound(arrOut), UBound(arrOut, 2)).FormulaLocal = arrOut
Else
With .Cells(2, 1)
.Value = "No Files in " & oFolder
With .Font
.Bold = True
.Size = 16
.Color = RGB(255, 0, 0)
End With
End With
End If
.Columns.AutoFit
.Activate
End With
Debug.Print Timer - t
End Sub
Sub prcFiles(oFolder, oDictF)
Dim oFile As Object
For Each oFile In oFolder.Files
With oFile
oDictF(.Path) = Array( _
Left(.Name, InStrRev(.Name, ".") - 1), _
Replace(.Name, Left(.Name, InStrRev(.Name, ".")), ""), _
oFolder.Name, _
Int(.Size / 1024), _
.DateLastModified, _
.DateCreated, _
.Path, _
"=HYPERLINK(""" & .Path & """;""" & "Klick" & """)")
End With
Next
End Sub
Sub prcSubFolders(oFolder, oDictF)
Dim oSubFolder As Object
For Each oSubFolder In oFolder.SubFolders
prcFiles oSubFolder, oDictF
prcSubFolders oSubFolder, oDictF
Next
End Sub

ca. 7 Sek. für 4800 Dateien in div. Ordnern und Unterordnern
Gruß
Rudi
Anzeige
AW: besser ist doch,
07.01.2021 16:44:55
Yal
Hallo zusammen,
ganz schön viel beigetragen hier. Ob ich da noch eine Mehrwert beitragen kann...
Erste Schritt: Ganz einfach als Status-Anzeige (unten rechts): 

Sub steht() 'da nur zur besseren abgrenzung
AnzahlDateien = objDateienliste.Count
With ActiveSheet
For Each objDatei In objDateienliste
.Cells(lngzeile, 3) = objDatei.Name
.Hyperlinks.Add Anchor:=Cells(lngzeile, 3), Address:=objDatei
.Cells(lngzeile, 8) = objDatei
.Cells(lngzeile, 2) = objVerzeichnis.Path
.Hyperlinks.Add Anchor:=Cells(lngzeile, 2), Address:=objVerzeichnis, TextToDisplay:= _
objVerzeichnis.Name
Application.StatusBar = lngzeile & " von " & AnzahlDateien & " geselesen (" & lngzeile / _
AnzahlDateien & "%)"
lngzeile = lngzeile + 1
Next objDatei
End With
Application.StatusBar = "Fertig"
Call UnterOrdnerAuslesen(objVerzeichnis)
Call SVERWEIS_Vlookup
Call Nummerierung
End Sub
VG
Yal
Anzeige
AW: besser ist doch,
07.01.2021 17:34:06
Luschi
Hallo Yal,
mit Application.StatusBar = … habe ich keine besonders guten Erfahrungen gemacht, denn das Ding läuft sich gerne fest, obwohl die Vba-Schleife selbst funktioniert und zum Ende kommt.
Das ist in Word-, Excel-, Access- und Outlook-Vba immer das selbe: ist die Anzahl der Durchläufe etwas größer, streikt die Statusbar in der Office-Anwendung.
Deshalb benutze ich seit Jahren ein nicht-modales Formular, daß ich per Win-API zwinge, immer im Bildschirm-Vordergrund zu sein. Nur bei Mehr-Bildschirm-Systemen will es mir nicht recht gelingen, das Progreßbar-Formular auf einem bestimmen Bildschirm anzuzeigen.
Gruß von Luschi
aus klein-Paris
Anzeige
AW: besser ist doch,
07.01.2021 18:51:59
Yal
Ich gebe zu, dass ich gesucht habe, wie man diese wieder "frei" gibt, aber nicht gefunden habe.
Man müsste auch ein "Pacer" einbauen, sodass nicht bei jeder Zeile aktualisiert wird, sondern pro 100er, 200er, ...
VG Yal
AW: besser ist doch,
07.01.2021 18:13:15
Nepumuk
Hallo Rudi,
beschleunigen mit dem FileSystemObject? Selten so gelacht. Das ist von allen Möglichkeiten die langsamste. Ich mach per API 42.000 Dateien in knapp 2,5 Sekunden.
https://www.herber.de/bbs/user/142834.xlsm
Gruß
Nepumuk
AW: ProgressBar
07.01.2021 17:27:51
volti
Hallo Steve,
hier ist noch eine Alternative...
Progressbar.zip
Gruß
Karl-Heinz
DANKE an Alle
08.01.2021 14:40:21
Steve
Moin Leute,
das war mal viel Stoff. Da muss ich mich erstmal reinarbeiten. Den Fortschritt in der Statusleiste anzuzeigen ist eine sehr gute Idee, aber meine User schauen da nicht hin. Die brauchen schon ein Scheunentor. Dennoch werde ich mal schauen das ich das umsetzen kann. Nur zur Übung.
Leider läuft der Datenzugriff über WLAN auf einen Server. Deshalb braucht das so lange.
Dennoch habe ich jetzt Stoff zum vergleichen und Nachbauen und lernen für die nächsten Tage.
(Irgendwie möchte der Chef das ich gelegentlich auch meine Arbeit mache.... :-D )
Ich dachte ich kann das mal eben so umsetzen, aber ich merke schon, dafür brauche ich länger.
Vielen Vielen Dank an alle.
Steve
AW: DANKE an Alle
08.01.2021 15:07:03
Nepumuk
Hallo Steve,
mein Makro mit Anzeige eines Fortschrittsbalken in der Statusleiste:
Public Sub DateiListe()
    
    Dim objFileSearch As clsFileSearch
    Dim objFileDialog As FileDialog
    Dim lngindex As Long, lngFileCount As Long, lngPercent As Long
    Dim dblPercent As Double
    Dim strFolder As String
    Dim avntValues() As Variant
    
    Set objFileDialog = Application.FileDialog(fileDialogType:=msoFileDialogFolderPicker)
    
    With objFileDialog
        .AllowMultiSelect = False
        If .Show Then strFolder = .SelectedItems(1) & "\"
    End With
    
    Set objFileDialog = Nothing
    
    If strFolder <> vbNullString Then
        
        Set objFileSearch = New clsFileSearch
        
        Call Columns("A:H").Clear
        
        Range("A1:H1").Value = Array("Name", "Ext", "Ordner", "kB", "le.Änd.", "Erstellt", "Pfad", "Link")
        
        Application.DisplayStatusBar = True
        
        With objFileSearch
            
            .Extension = "*.*"
            .FolderPath = strFolder
            .SearchLike = "*"
            .SubFolders = True
            
            lngFileCount = .Execute(Sort_by_Path, Sort_Order_Ascending)
            
            dblPercent = 100 / lngFileCount
            
            Redim avntValues(1 To lngFileCount, 1 To 7)
            
            For lngindex = 1 To lngFileCount
                
                With .Files(lngindex)
                    
                    If InStr(1, .Filename, ".") Then
                        
                        avntValues(lngindex, 1) = Left$(.Filename, InStrRev(.Filename, ".") - 1)
                        avntValues(lngindex, 2) = Mid$(.Filename, InStrRev(.Filename, ".") + 1)
                        
                    Else
                        
                        avntValues(lngindex, 1) = .Filename
                        avntValues(lngindex, 2) = "-"
                        
                    End If
                    
                    avntValues(lngindex, 3) = Left$(.Path, InStrRev(.Path, "\") - 1)
                    avntValues(lngindex, 4) = Fix(.Size / 1024)
                    avntValues(lngindex, 5) = .LastModify
                    avntValues(lngindex, 6) = .DateCreate
                    avntValues(lngindex, 7) = .Path
                    
                    lngPercent = Clng(dblPercent * lngindex)
                    
                    Application.StatusBar = " " & CStr(lngPercent) & " % " & String$(lngPercent \ 2, ChrW$(9609))
                    
                    DoEvents
                    
                End With
            Next
        End With
        
        Set objFileSearch = Nothing
        
        Application.ScreenUpdating = False
        
        Range(Cells(2, 1), Cells(lngFileCount + 1, 7)).Value = avntValues
        Range(Cells(2, 8), Cells(lngFileCount + 1, 8)).FormulaR1C1 = "=HYPERLINK(RC[-1],""Klick"")"
        
        With Application
            .ScreenUpdating = True
            .StatusBar = False
        End With
        
    End If
End Sub

Gruß
Nepumuk
AW: DANKE an Alle
08.01.2021 15:12:06
Steve
Hallo Nepomuk,
das wollte ich direkt mal ausprobieren.
Allerdings meckert VBA hier:
Dim objFileSearch As clsFileSearch
"Fehler beim Kompilieren: Benutzerdefinierter Typ nicht definiert."
Woran kann das liegen?
Gruß
Steve
AW: DANKE an Alle
08.01.2021 15:14:52
Nepumuk
Hallo Steve,
du musst meine Mappe herunterladen und das Makro in Modul1 ersetzen.
Gruß
Nepumuk
AW: DANKE an Alle
08.01.2021 15:49:35
Steve
Hallo Nepomuk,
das ist ja unglaublich. Das geht ja trotz Server sehr schnell. Wie kommt das?
Dann werde ich mich mal dranmachen und versuchen das alles zu verstehen und dann auf mein Design umzuändern.
Ich danke dir sehr dafür.
Steve
AW: DANKE an Alle
08.01.2021 15:51:57
Nepumuk
Hallo Steve,
Wie kommt das?
Die Basis des Codes sind Windowseigene Funktionen die genutzt werden.
Gruß
Nepumuk
AW: DANKE an Alle
08.01.2021 16:00:51
Steve
Hallo Nepomuk,
ich hab soeben in das Klassenmodul reingeschaut. Das ist weit weg von dem was ich kann oder verstehe.
Ich hoffe ich kann das nach meinen Bedürfnissen anpassen ohne was kaputt zu machen.
Ich denke auskommentieren geht immer oder?
So sollte ich dann ja einige Dinge wie z.B. den letzten Zugriff ausschalten können.
Sehe ich das richtig?
Dann würde ich das nämlich anpassen.
Den Link z.B. habe ich direkt auf dem Namen der Datei.
Nicht das ich deine Datei nicht einfach verwenden könnte. Aber ich möchte ja auch was dazulernen.
Gruß
Steve
AW: DANKE an Alle
08.01.2021 16:05:56
Nepumuk
Hallo Steve,
die Klasse solltest du lassen wie sie ist. Das Makro im Modul1 kannst du anpassen wie du willst, da kannst du nicht viel kaputt machen. Wenn's klemmt, einfach fragen.
Gruß
Nepumuk
AW: DANKE an Alle
08.01.2021 16:11:04
Steve
Hallo Nepomuk,
Okay. Gut zu wissen. Dann mache ich das mal und melde mich falls es nicht geht.
Vieles kann ich ja schon umsetzen.
Ich nehme an so Dinge wie ein Doppelklick-Event usw. kann ich dennoch problemlos erstellen?.
Hab mir ein Makro erstellt das dem Pfad folgt und mich befähigt die Datei umzubenennen
Aber die laufen ja unabhängig von deinem Makro.
Gruß Steve

Links zu Excel-Dialogen

Label UserForm

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige