VBA keine Rückmeldung/Screenupdating

[Topology]

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?

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

[Steffl]

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.

[Topology]

@ 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:)

[snb]

Eine Textdatei + Exceldatei hochladen ?

Code:

sn=split(createobject("scripitng.filesystemobject").opentextfile("G:\OF\beispiel.txt").readall,vbcrlf)

[atilla]

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.

[Topology]

Eine Textdatei + Exceldatei hochladen ?

Code:

sn=split(createobject("scripitng.filesystemobject").opentextfile("G:\OF\beispiel.txt").readall,vbcrlf)

? was meinst du damit?

[Topology]

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=(

[Kuwer]

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

[Topology]

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...

[Topology]

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!=)