Mehrmaliges Aufrufen führt zu Fehler

Hallo,

ich erhalte einen Fehler, der sich meiner Logik entzieht und der leider nicht ganz leicht zu beschreiben ist:
Ich rufe eine Prozedur auf, dort wird ein Loop durchlaufen, in dem mit einem RSAPI.dll-Befehl der Com-Port ausgelesen wird, dann ein Zähler hochgesetzt, ein Beep gemacht, in der Statuszeile der Zählerwert ausgegeben und der Loop erst dann verlassen, wenn der Com-Port etwas brauchbares ausgespuckt hat. Der Loop befindet sich wiederum in einer For-Schleife, wenn die fertig ist, ist Feierabend.
Beim ersten mal funktioniert das auch so. Rufe ich aber direkt danach die Prozedur nochmal auf, Beepts und der Zähler wird hochgezählt, aber es erfolgt keine Statuszeilenausgabe und kein Com-Portlesen. Woran kann das liegen? Muss man beim beenden einer Sub irgendwelche Resourcen wieder freigeben oder stimmt meine Vermutung, dass das ganze vielleicht an der RSAPI hängt?

Danke. Tobze

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Der Code ist ziemlich lang und ich bin der Meister der Übersichtlichkeit, aber ich probiers mal:

Sub Messen(Merkmal As Integer) ' Messung durchführen
a$ = " " ' Einlesebuffer dimensionieren
CLOSECOM
OPENCOM "COM1,9600,N,8,2" ' Com-Port öffnen
TIMEOUT 100
AktZeile = Merkmal + 14 ' Zeile im Protokoll bestimmen
AktSpalte = Merkmal * 2 ' Ausgabespalte der Messwerte festlegen
Anz = Worksheets("Protokoll").Cells(AktZeile, 9).Value
Soll = Worksheets("Protokoll").Cells(AktZeile, 3).Value
WarnO = Soll + Worksheets("Protokoll").Cells(AktZeile, 5).Value
WarnU = Soll - Worksheets("Protokoll").Cells(AktZeile, 7).Value
FehlerO = WarnO + Messungenauigkeit
FehlerU = WarnU - Messungenauigkeit
Worksheets("Messwerte").Activate
ActiveSheet.Unprotect
Range(Cells(2, AktSpalte), Cells(65535, AktSpalte)).Value = ""
Range(Cells(2, AktSpalte), Cells(65535, AktSpalte)).Interior.ColorIndex = xlNone
Range(Cells(6, AktSpalte - 1), Cells(65535, AktSpalte - 1)).Value = ""
Range(Cells(6, AktSpalte - 1), Cells(65535, AktSpalte - 1)).Interior.ColorIndex = 15
Range(Cells(6, AktSpalte - 1), Cells(65535, AktSpalte - 1)).Interior.Pattern = xlSolid
Cells(2, AktSpalte).Value = Soll ' Sollmass eintragen
Cells(3, AktSpalte).Value = WarnO ' Maximum eintragen
Cells(4, AktSpalte).Value = WarnU ' Minimum eintragen
Cells(5, AktSpalte).Value = Anz ' Stichprobenumfang eintragen
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False

' Messungen durchführen

For Messwertnr = 1 To Anz
MsgBox "Aktueller Stand: " + CStr(icount)

Do '******************* hier gehts los ************
laenge = READSTRING(a$)
DoEvents
icount = icount + 1
Piep 0
Application.StatusBar = a$ + " ist hier." + CStr(icount) + " / " + CStr(laenge)
Loop While laenge = 0 Or Left(a$, 3) <> "01A" '******************* hier hörts auf ************

If InStr(a$, ".") <> 0 Then
a$ = Left(a$, InStr(a$, ".") - 1) & "," & Right(a$, Len(a$) - InStr(a$, ".")) ' Punkt durch Komma ersetzen
End If
b$ = Right(a$, 9)
wert = CSng(b$)
wert = Application.WorksheetFunction.Round(wert, 3) ' Runden, um die von Excel erfundenen Nachkommastellen abzuschneiden
If wert >= FehlerU And wert <= FehlerO Then
If wert >= WarnU And wert <= WarnO Then ' Wert liegt innerhalb der Toleranz

Piep 0
Worksheets("Messwerte").Activate
ActiveSheet.Unprotect
Call Scroller(Messwertnr, AktSpalte - 1)
ActiveCell.Value = wert
ActiveCell.Interior.ColorIndex = 4
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False

Else ' Wert liegt innerhalb der Messungenauigkeit

Piep 1
AnzWarn = AnzWarn + 1
Worksheets("Messwerte").Activate
ActiveSheet.Unprotect
Call Scroller(Messwertnr, AktSpalte - 1)
ActiveCell.Value = wert
ActiveCell.Interior.ColorIndex = 6
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False

End If
Else ' Messwert liegt ausserhalb der Messungenauigkeit

Piep 2
AnzFehler = AnzFehler + 1
Worksheets("Messwerte").Activate
ActiveSheet.Unprotect
Call Scroller(Messwertnr, AktSpalte - 1)
ActiveCell.Value = wert
ActiveCell.Interior.ColorIndex = 3
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False

End If
a$ = " "
Next Messwertnr
CLOSECOM
Worksheets("Messwerte").Activate
ActiveSheet.Unprotect
Piep 3
MsgBox "Messung beendet!"

' Berechnungen machen und im Protokoll eintragen

Worksheets("Protokoll").Cells(AktZeile, 11).Value = Application.WorksheetFunction.Average(Range(Cells(6, AktSpalte), Cells(Anz + 6, AktSpalte)))
Worksheets("Protokoll").Cells(AktZeile, 13).Value = Application.WorksheetFunction.StDev(Range(Cells(6, AktSpalte), Cells(Anz + 6, AktSpalte)))
Worksheets("Protokoll").Cells(AktZeile, 15).Value = Application.WorksheetFunction.Min(Range(Cells(6, AktSpalte), Cells(Anz + 6, AktSpalte)))
Worksheets("Protokoll").Cells(AktZeile, 17).Value = Application.WorksheetFunction.Max(Range(Cells(6, AktSpalte), Cells(Anz + 6, AktSpalte)))
Worksheets("Protokoll").Cells(AktZeile, 19).Value = AnzFehler
Worksheets("Protokoll").Cells(AktZeile, 21).Value = AnzWarn
Worksheets("Protokoll").OLEObjects(28 + Merkmal).Enabled = True
Enabler
Worksheets("Protokoll").Activate
End Sub

Beliebteste Forumthreads (12 Monate)

Mehrmaliges Aufrufen führt zu Fehler

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread