Hallo liebe EXCEL VBA Profis=D
ich Lade Daten aus einer .txt Datei, diese vergleicht die Daten mit einer anderen Excel Datei, wenn sie übereinstimmen werden Sie in meine Mappe hineingeschrieben.
Nun bei dieser Prozedur möchte ich dass der Bildschirm sich nicht aktualisiert. das klappt auch.
Zudem dauert das ca. 1 Minute deshalb möchte ich eine User Form einbauen welche die ganze zeit über geöffnet bleibt und sich schließt bei Prozedur Ende.
Fehler 1: Die Userform zeigt den Text nicht an.
Fehler 2: Das Excel workbook zeigt oben "keine Rückmeldung" an, die Pozedur läuft jedoch ohne Probleme weiter.
Fehler 3: wenn ich DoEvents einfüge aktualisiert sie die Tabelle wieder
wie kann ich das am besten lösen?
Zitat:Code:
UserFormWait.Show vbModeless
UserFormWait.Label1 = "please wait until the transfer has been completed, thank you."
Die Excel selbst kann ich leider nicht hochladen...
Dankee=)
liebe Grüße
Hallo,
nur mit diesen zwei Codezeilen kannst Du wahrscheinlich keine Lösung erhalten. Es was hier keiner, wie Du die Textdateien lädst, vergleichst, in die Tabelle schreibst usw. Wir brauchen also zumindest deinen gesamten Code.
@ steffl
Code:
Sub QM_Laden_Aus_Part()
'QM`s aus Zeichnung und Teil laden
'--------------- (das sind meine versuche =D):
UserFormWait.Show vbModeless
UserFormWait.Label1 = "please wait until the transfer has been completed, thank you."
'MsgBox "start transfer & please wait until the transfer has been completed"
Dim OldstatusBar
OldstatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Application.StatusBar = "please wait until the transfer has been completed..."
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual 'automat.Berechnung ausschalten
'---------------
On Error Resume Next
Dim Temp As Workbook, PartFamily As Workbook
Dim Dimensioning As Workbook
Set Dimensioning = ActiveWorkbook 'DIMENSIONING WORKSHEET
Dim Num As String
Num = Range("Q5").Text ' Produktnummer
'-PART FAMILY WORKSHEET
For Each Temp In Application.Workbooks
If Temp.Sheets(1).Range("A20").Text = "Partfamily_1.1" Then 'Wenn richtige Version der Teilefamilie
If Temp.Sheets(1).Range("A21").Text = Num Then 'Wenn richtige Produkt-Nummer
Set PartFamily = Temp
Exit For
End If
End If
Next Temp
If PartFamily Is Nothing Then
MsgBox "Please open PartFamily"
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Exit Sub
End If
'-
Dim Start As Integer
Start = 6
Dim Ende As Integer
Ende = PartFamily.ActiveSheet.Cells(1, Start).End(xlToRight).Column
Dim Zeile As String
Dim Zeilen() As String
ReDim Zeilen(0)
Dim FNr As Integer
FNr = FreeFile
If Dir("C:\TEMP\QM_List_Output.txt") <> "" Then
Open "C:\TEMP\QM_List_Output.txt" For Input As #FNr
Else
MsgBox "no QM.txt file"
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic 'automat.Berechnung einschalten
Exit Sub
End If
'auslesen bis zum Dateiende
Do Until EOF(FNr)
'zeilenweise auslesen und übernehmen
Line Input #FNr, Zeile
If Left(Zeile, 1) <> "!" Then
If Trim(Zeile) <> "" Then
Zeilen(UBound(Zeilen)) = Zeile
ReDim Preserve Zeilen(UBound(Zeilen) + 1)
End If
End If
Loop
ReDim Preserve Zeilen(UBound(Zeilen) - 1)
Close #FNr
Dim i As Integer
Dim ii As Integer
Dim Werte() As String
Dim Var As String
For i = Ende To Start + 1 Step -1
Dimensioning.ActiveSheet.Range("E" & begin).Select
Call NXParameter
Dimensioning.ActiveSheet.Range("E" & begin).Value = UCase(Trim(PartFamily.ActiveSheet.Cells(1, i).Value)) 'QM
For ii = 0 To UBound(Zeilen)
Werte = Split(Zeilen(ii), "|")
ReDim Preserve Werte(3)
Var = UCase(Trim(Werte(0)))
If Right(Var, 4) = "(KM)" Or Right(Var, 4) = "(HM)" Or Right(Var, 4) = "(SC)" Or Right(Var, 4) = "(CC)" Then
Var = Trim(Left(Var, Len(Var) - 4))
End If
Werte(0) = Var
If Var = UCase(Trim(PartFamily.ActiveSheet.Cells(1, i).Value)) Then
Dimensioning.ActiveSheet.Range("M" & begin).Value = Werte(1) 'Nennmaß
Dimensioning.ActiveSheet.Range("Q" & begin).Value = Werte(2) 'obere Toleranz
Dimensioning.ActiveSheet.Range("U" & begin).Value = Werte(3) 'untere Toleranz
End If
Next
Next
UserFormWait.Hide
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.StatusBar = False
Application.DisplayStatusBar = OldstatusBar
End Sub
=D bisschen lang/bisschen kompliziert... wenn Erklärungen benötigt einfach schreiben :)
dankeschööön:)
Eine Textdatei + Exceldatei hochladen ?
Code:
sn=split(createobject("scripitng.filesystemobject").opentextfile("G:\OF\beispiel.txt").readall,vbcrlf)
Hallo,
versuch folgendes mal:
Code:
DoEvents
UserFormWait.Show vbModeless
UserFormWait.Label1 = "please wait until the transfer has been completed, thank you."
Es ist nur DoEvents als Befehl vor dem Anzeigen der Userform dazugekommen. Damit müsste die Form zu sehen sein, wenn nicht, dann frag noch einmal nach.
(30.03.2018, 17:50)atilla schrieb: [ -> ]Hallo,
versuch folgendes mal:
Code:
DoEvents
UserFormWait.Show vbModeless
UserFormWait.Label1 = "please wait until the transfer has been completed, thank you."
Es ist nur DoEvents als Befehl vor dem Anzeigen der Userform dazugekommen. Damit müsste die Form zu sehen sein, wenn nicht, dann frag noch einmal nach.
nein leider klappt das nicht.
Wenn es Excel nicht aufhängt das flackert das Bild=(
Hallo,
wenn Du eine Userform hast, dann starte die Geschichte aus der heraus (z.B. automatisch über Private Sub UserForm_Initialize()).
Auf die Statusbar brauchst Du doch auch nicht zugreifen, weil du die Informationen doch direkt in der UF, z.B. in einem Label, darstellen kannst.
Gruß Uwe
(03.04.2018, 13:03)Kuwer schrieb: [ -> ]Hallo,
wenn Du eine Userform hast, dann starte die Geschichte aus der heraus (z.B. automatisch über Private Sub UserForm_Initialize()).
Auf die Statusbar brauchst Du doch auch nicht zugreifen, weil du die Informationen doch direkt in der UF, z.B. in einem Label, darstellen kannst.
Gruß Uwe
leider klappt das auch nicht=(
Application.ScreenUpdating = False
funktioniert dann iwie nicht =D alles wird immer aktualisiert... ach blöd...
habs geschafft=)
mein Fehler war dass ich in den Subs die ich in der Prozedur verwende, weitere Subs benutze in welchen ich
Application.ScreenUpdating = False
Application.ScreenUpdating = True
verwendet habe, somit hat sich das immer wieder aufgehoben...
danke für die Hilfe!=)