Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Userform
BildScreenshot zu Userform Userform-Seite mit Beispielarbeitsmappe aufrufen

Ladebalken mit VBA

Betrifft: Ladebalken mit VBA von: Frederic
Geschrieben am: 17.09.2020 09:26:44

Hallo zusammen

ist es möglich für diesen Code solch eine Art Ladebalken zu erstellen, da auch ich im Code im Endeffekt nur Spalten kopiere..?
https://www.herber.de/bbs/user/140278.xlsm

ich weiß nicht wie ich den Ladebalken in den Code bekomme.. Userform erstellen und so ok, aber aktuell drückt man gant normal auf eine Schaltfläche. Es müsste dann ja per Command Button erfolgen oder?

<pre>Sub prcAktualisieren_Pivot()
Dim FSO As Object
Dim fsoFolder As Object
Dim fsoFile As Object
Dim zeiQ As Long, varProdukt, strProdukt, varDB_I, varDB_II, varDB_III, varDB_IIII, varDB_IIIII
Dim strMM_JJJJ As String, iJahr As Integer, iMonat As Integer
Dim spaV As Long, rngProdNr As Range, zeiProdNr As Long, zeiVL As Long
Dim wkbQ As Workbook, wksQ As Worksheet
Dim wkbVerlauf As Workbook, wksVerlauf As Worksheet, strVerlauf As String
Dim zeiSL As Long, iCount As Integer
Dim objL As ListObject


With Tab_Steuerung
'1. Spalte der Liste mit den eingeslesene Dateien für die Pivotauswertung
spaV = .ListObjects(2).Range.Column
'letzte Zeile mit in Liste der eingelesenen Dateien
zeiSL = .Cells(.Rows.Count, spaV).End(xlUp).Row
If .Cells(zeiSL, spaV) = "" Then zeiSL = zeiSL - 1
'Jahr und Monat der letzten eingelesenen Datein einlesen
iJahr = .Range("D3").Value
If iJahr < 2000 Or iJahr > 3000 Then
MsgBox "Bitte in Zelle D3 das Jahr für den Verlauf der DB eingeben!"
End If
iMonat = .ListObjects(2).DataBodyRange.Range("C1").Value
If iMonat = 12 Then iMonat = 1 Else iMonat = iMonat + 1
'Name des Ordners mit den Monatsdaten berechnen
strMM_JJJJ = Format(iMonat, "00_") & Format(iJahr, "0000")
End With

If MsgBox("Dekungsbeiträge für Monat " & strMM_JJJJ & " einlesen?", _
vbOKOnly + vbQuestion, _
"D B E I N L E S E N") = vbCancel Then Exit Sub

'Blatt in das die Daten eingelesen werden sollen
strVerlauf = Tab_Steuerung.Range("K4").Text
'Verzeichnis vom Namen abtrennen
strVerlauf = Mid(strVerlauf, InStrRev(strVerlauf, "\") + 1)
'prüfen, ob Datei schon geöffnet ist
For Each wkbVerlauf In Application.Workbooks
If LCase(wkbVerlauf.Name) = LCase(strVerlauf) Then
Exit For
End If
Next
If wkbVerlauf Is Nothing Then
Set wkbVerlauf = Application.Workbooks.Open(Filename:=Tab_Steuerung.Range("M2").Text)
End If
Set wksVerlauf = wkbVerlauf.Worksheets("Daten")

'Ordner mit den Monatsdaten setzen
Set FSO = VBA.CreateObject("Scripting.FileSystemObject")
Set fsoFolder = FSO.getfolder(Tab_Steuerung.Range("D2").Text & "\" & strMM_JJJJ) 'Ordner des gewählten Monats

With wksVerlauf
'letze Zeile mit ProduktNr Spalte in Spalte A
zeiVL = .Cells(.Rows.Count, 1).End(xlUp).Row
If .Cells(zeiVL, 1) = "" Then zeiVL = zeiVL - 1
End With
'Datei mit den DB-Daten des Monats im Ordner suchen
For Each fsoFile In fsoFolder.Files
If fsoFile.Name Like "DB_" & strMM_JJJJ & "_Master.xls*" Then
'Datei mit DB-Daten schreibgeschützt öffnen
Set wkbQ = Application.Workbooks.Open(fsoFile.Path, ReadOnly:=True)
Set wksQ = wkbQ.Worksheets(1)
With wksQ
'Produktnummern abarbeiten
For zeiQ = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
'Daten zum Produkt in Variablen speichern
varProdukt = .Cells(zeiQ, 1).Value 'Produktnummer
varDB_I = .Cells(zeiQ, 2).Value 'DB1
varDB_II = .Cells(zeiQ, 3).Value 'DB2
varDB_III = .Cells(zeiQ, 4).Value 'DB3
varDB_IIII = .Cells(zeiQ, 5).Value 'DB4


'Daten im Blatt "Daten" in nächste freie Zeile schreiben
With wksVerlauf
zeiVL = zeiVL + 1
.Cells(zeiVL, 1) = strMM_JJJJ
.Cells(zeiVL, 2) = Val(Right(strMM_JJJJ, 4))
.Cells(zeiVL, 3) = Val(Left(strMM_JJJJ, 2))
.Cells(zeiVL, 4).Value = varProdukt
.Cells(zeiVL, 5).Value = varDB_I
.Cells(zeiVL, 6).Value = varDB_II
.Cells(zeiVL, 7).Value = varDB_III
.Cells(zeiVL, 8).Value = varDB_IIII
.Cells(zeiVL, 9).Value = varDB_IIIII

Next
'Datei in Liste der eingelesenen Dateien eintragen
With Tab_Steuerung
iCount = iCount + 1
zeiSL = zeiSL + 1
.Cells(zeiSL, spaV).Value = strMM_JJJJ
.Cells(zeiSL, spaV + 1).Value = Val(Right(strMM_JJJJ, 4))
.Cells(zeiSL, spaV + 2).Value = Val(Left(strMM_JJJJ, 2))
.Cells(zeiSL, spaV + 3).Value = iCount
.Cells(zeiSL, spaV + 4).Value = fsoFile.Name
.Cells(zeiSL, spaV + 5).Value = Now
End With
End With
'Datei mit Net Fees wieder schliesen
Set wksQ = Nothing
wkbQ.Close savechanges:=False
Set wkbQ = Nothing
Exit For
End If
Next fsoFile

'Liste der eingelesennen Dateien sortieren, so das der zuletzt eingelesene Monat in der 1. Zeile steht
With Tab_Steuerung
Set objL = .ListObjects(2)
objL.Sort.SortFields.Clear
objL.Sort.SortFields. _
Add2 Key:=.Range(objL.Name & "[Jahr]"), SortOn:=xlSortOnValues, _
Order:=xlDescending, DataOption:=xlSortNormal
objL.Sort.SortFields. _
Add2 Key:=.Range(objL.Name & "[Monat]"), SortOn:=xlSortOnValues, _
Order:=xlDescending, DataOption:=xlSortNormal
objL.Sort.SortFields. _
Add2 Key:=.Range(objL.Name & "[lfd.Nr]"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
With objL.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
ThisWorkbook.Save

'Pivottabellenbericht in Blatt "Auswertung" aktualisieren
wkbVerlauf.Worksheets("Auswertung").PivotTables(1).RefreshTable

wkbVerlauf.Save
wkbVerlauf.Worksheets("Auswertung").Activate

Fehler:
With Err
Select Case .Number
Case 0
Case 76
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description & vbLf & vbLf _
& Tab_Steuerung.Range("D2").Text & "\" & strMM_JJJJ, _
vbOKOnly, "Fehler Makro: prcAktualisieren"
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _
vbOKOnly, "Fehler Makro: prcAktualisieren"
If Not wkbVerlauf Is Nothing Then wkbVerlauf.Close savechanges:=True
End Select
End With

'Makrobremsen zurücksetzen
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub</pre>

Betrifft: AW: Ladebalken mit VBA
von: Luschi
Geschrieben am: 17.09.2020 10:28:14

Hallo Frederic,

Dein Beispiel sieht nett aus, ist aber für Deine Zwecke kaum brauchbar, da Prozesse stattfinden, die nicht per Fortschrittsbalken abgebildet werden können:
- Dauer des Öffnens der einzulesenden Dateien

Aber andere Teilschritte, wie Einlesen der Daten, dagegen sind ohne Weiteres im Fortschritt darstellbar.
Ich mache das mit Hilfe einer ungebundenen Userform, so das der Vba-Code agieren kann und der Fortschritt in der Userform angezeigt wird.
Dafür solltest Du aber
- eine Demodatei, in die die Daten eingelesen werden
- 1 besser 2 ... Dateien mit den Einlesendaten
bereitstellen, die im Aufbau den Originaldateien entsprechen

Gruß von Luschi
aus klein-Paris

Betrifft: AW: Ladebalken mit VBA
von: Frederic
Geschrieben am: 17.09.2020 18:18:25

datei ist zu groß als ZIP..
kann ich dir die anders zukommen lassen?



Beste Grüße
Frederic

Betrifft: AW: Ladebalken mit VBA
von: Frederic
Geschrieben am: 17.09.2020 21:41:49

habs ;)
https://www.herber.de/bbs/user/140296.zip

Gruß
Frederic

Betrifft: @Luschi Antwort
von: Frederic
Geschrieben am: 21.09.2020 16:39:40

Hey ;)

hast du meine Antwort gesehen? :)

Gruß
Frederic

Betrifft: @Luschi Antwort
von: Frederic
Geschrieben am: 21.09.2020 16:39:41

Hey ;)

hast du meine Antwort gesehen? :)

Gruß
Frederic

Betrifft: AW: Ladebalken mit VBA
von: volti
Geschrieben am: 17.09.2020 11:53:50

Hallo Frederic,

hier ein Beispiel für einen Ladebalken:

Ladenbalken

Die Weiterschaltung des Fortschrittsbalken kann an geeigneten Stellen erfolgen. Habe mir Deinen code allerdings nicht intensiv angeschaut, um zu wissen, ob und wo das sinnvoll ist.

Schau einfach mal, ob's weiterhilft.

viele Grüße
Karl-Heinz

Betrifft: AW: Ladebalken mit VBA
von: Daniel
Geschrieben am: 17.09.2020 19:01:17

Hi
ich vermute mal, dass sich der Ladebalken erübrigt, wenn du bei Lückenlos zusammenhängenden Zellbereichen nicht jede Zelle einzeln überträgst, sondern den ganzen Zellblock in einem Schritt als ganzes kopierst und einfügst.

Gruß Daniel

Betrifft: AW: Ladebalken mit VBA
von: Frederic
Geschrieben am: 17.09.2020 21:36:45

Hey Daniel,

das kann gut sein, jedoch muss ich ja die Produktnummer immer matchen.. geht es dann trotzdem wenn man es als ganzen Block kopiert?

Gruß
Frederic

Betrifft: AW: Ladebalken mit VBA
von: Daniel
Geschrieben am: 17.09.2020 22:21:20

Vom einem Matching der Produktnummern kann ich in deinem Code nichts finden, du überträgst die Werte 1:1, von daher kann man sie auch als ganzes Kopieren.

Selbst wenn, dann kann man zumindest die Werte einer Zeile als Block kopieren (sofern die Anordnung der Spalten gleich ist) und Werte, die sich nicht ändern (Datum) kann man auch als Block einfügen.

Da Excel im Sortieren sehr schnell ist, kann man wenn nicht alle Zeilen über tragen werden sollen, über diesen Weg erreichen dass die zu übertragenden Zeilen einen lückenlosen Block bilden, der in einem Schritt über tragen werden kann.

Gruß Daniel

Betrifft: AW: Ladebalken mit VBA
von: Frederic
Geschrieben am: 18.09.2020 11:14:01

jaa stimmt.. das matchen übernimmt ja die Pivot :)
da ich in VBA nicht wirklich gut bin, weiß ich grade nicht so wie ich das anstellen muss..

Gruß
Frederic

Betrifft: AW: Ladebalken mit VBA
von: Frederic
Geschrieben am: 18.09.2020 11:14:02

jaa stimmt.. das matchen übernimmt ja die Pivot :)
da ich in VBA nicht wirklich gut bin, weiß ich grade nicht so wie ich das anstellen muss..

Gruß
Frederic

Betrifft: AW: Ladebalken mit VBA
von: Frederic
Geschrieben am: 18.09.2020 11:14:06

jaa stimmt.. das matchen übernimmt ja die Pivot :)
da ich in VBA nicht wirklich gut bin, weiß ich grade nicht so wie ich das anstellen muss..

Gruß
Frederic

Betrifft: AW: Ladebalken mit VBA
von: Frederic
Geschrieben am: 18.09.2020 11:14:06

jaa stimmt.. das matchen übernimmt ja die Pivot :)
da ich in VBA nicht wirklich gut bin, weiß ich grade nicht so wie ich das anstellen muss..

Gruß
Frederic

Betrifft: AW: Ladebalken mit VBA
von: Frederic
Geschrieben am: 18.09.2020 11:14:07

jaa stimmt.. das matchen übernimmt ja die Pivot :)
da ich in VBA nicht wirklich gut bin, weiß ich grade nicht so wie ich das anstellen muss..

Gruß
Frederic

Betrifft: AW: Ladebalken mit VBA
von: Frederic
Geschrieben am: 18.09.2020 11:14:07

jaa stimmt.. das matchen übernimmt ja die Pivot :)
da ich in VBA nicht wirklich gut bin, weiß ich grade nicht so wie ich das anstellen muss..

Gruß
Frederic

Betrifft: AW: Ladebalken mit VBA
von: Frederic
Geschrieben am: 18.09.2020 11:14:11

jaa stimmt.. das matchen übernimmt ja die Pivot :)
da ich in VBA nicht wirklich gut bin, weiß ich grade nicht so wie ich das anstellen muss..

Gruß
Frederic

Betrifft: AW: Ladebalken mit VBA
von: Frederic
Geschrieben am: 18.09.2020 11:14:12

jaa stimmt.. das matchen übernimmt ja die Pivot :)
da ich in VBA nicht wirklich gut bin, weiß ich grade nicht so wie ich das anstellen muss..

Gruß
Frederic

Betrifft: AW: Ladebalken mit VBA
von: Frederic
Geschrieben am: 18.09.2020 11:14:12

jaa stimmt.. das matchen übernimmt ja die Pivot :)
da ich in VBA nicht wirklich gut bin, weiß ich grade nicht so wie ich das anstellen muss..

Gruß
Frederic

Betrifft: AW: Ladebalken mit VBA
von: Frederic
Geschrieben am: 18.09.2020 11:16:23

oh man sry.. irgendwie hat die Seite etwas gespackt und habe dann mehrmals draufgedrückt ...
daher immer das gleiche..