Muster VBA Fortschrittsbalken integrieren?
06.01.2018 07:59:22
Jürgen
das Thema eines Fortschrittsbalken ist ja ziemlich oft zu finden.
Mein Problem als VBA DAU ist es allerdings das gefundene Beispiel in mein Projekt zu integrieren. Evtl. könnte mir jemand Hilfe dazu geben.
Der Muster Fortschrittsbalken wäre der hier:
https://www.herber.de/bbs/user/118719.xlsm
Mein VBA Code, welcher txt-Daten importiert lautete so:
Dim dateien()
Option Explicit
Sub DateienLesen()
Call EventsOff
Dim DateiName As String
Dim quelle As String
Dim i As Long
Dim j As Long
Dim zeile As String
Dim inhalt
Dim Ende
Dim nr
Dim utf As Boolean
Dim prüfen As Boolean
Dim erstezeile As Boolean
Dim text As String
ReDim dateien(0)
dateien(0) = 0
quelle = "D:\ITK\Einspielungen" 'Pfad eintragen
Call txtsuchen(quelle)
If dateien(0) = 0 Then
MsgBox "Keine .txt Dateien gefunden!"
Else
'Daten auslesen
For i = 1 To dateien(0)
DateiName = dateien(i)
Ende = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row
Ende = Ende + 2
nr = FreeFile()
utf = False
prüfen = False
erstezeile = False
Open DateiName For Input As #nr
Do While Not EOF(nr)
Line Input #nr, zeile
inhalt = Split(zeile, Chr(9))
If prüfen = False Then
If Len(inhalt(0)) > 2 Then
If Asc(Left(inhalt(0), 1)) = 239 And Asc(Mid(inhalt(0), 2, 1)) = 187 And _
Asc(Mid(inhalt(0), 3, 1)) = 191 Then utf = True
End If
prüfen = True
text = inhalt(2)
End If
For j = 0 To UBound(inhalt)
If utf = True Then
If erstezeile = False Then
If j = 0 Then inhalt(j) = Mid(inhalt(j), 4, Len(inhalt(j)))
If IsNumeric(inhalt(j)) Then inhalt(j) = Replace(inhalt(j), ",", ".")
ActiveSheet.Cells(Ende, 3 + j) = FromUTF8String(inhalt(j))
erstezeile = True
Else
If IsNumeric(inhalt(j)) Then inhalt(j) = Replace(inhalt(j), ",", ".")
ActiveSheet.Cells(Ende, 3 + j) = FromUTF8String(inhalt(j))
End If
Else
If IsNumeric(inhalt(j)) Then inhalt(j) = Replace(inhalt(j), ",", ".")
ActiveSheet.Cells(Ende, 3 + j) = inhalt(j)
End If
Next j
ActiveSheet.Cells(Ende, 6) = text
Ende = Ende + 1
Loop
Close #nr
Next i
End If
Call tausch
ActiveSheet.Range("C:D").Columns.AutoFit
ActiveSheet.Range("C:D").NumberFormat = "0.000000"
Call EventsOn
Call Zellformeln
Dim lngLastUsedRow As Long 'Datensätze auslesen und in MsgBox anzeigen
lngLastUsedRow = Worksheets("Tabelle1").Columns(1).Find(What:="*", LookIn:=xlValues, _
Lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
MsgBox "Daten erfolgreich eingelesen!"
End Sub
Wenn ich das UserForm integriert habe, wie müsste ich dann noch den VBA Code von "Private
Sub UserForm_Activate()" zu meinem Import-Code anpassen?
Danke & Gruss,
Juergen