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>