Das Makro für Excel
Als nächstes braucht man ein passendes Makro. Der Einfachheit halber habe ich mein Makro unten angefügt. Hier das Original: Modul1.bas
Die komplette Excel Auswertung findet sich hier. An das Makro kommt man heran, in dem man die Tasten [ALT]+[F11] gleichzeitigt drückt.Erklärung des Makros
Mit dem ersten Teil des Makros wird Excel mitgeteilt, daß es verschiedene neue Funktionen hat, die in einer Library RSAPI.DLL zu finden sind. Diese Library ist im Internet zu finden. z.B. bei http://www.b-kainka.de/msrwefaq.htm. Diese Datei muß in das Windows Verzeichnis kopiert werden, damit die datei gefunden wird.
-
Deklarationsteil
Declare Sub OPENCOM Lib "RSAPI.DLL" (ByVal A$)
Declare Sub CLOSECOM Lib "RSAPI.DLL" ()
Declare Sub TIMEOUT Lib "RSAPI.DLL" (ByVal ms%)
Declare Sub STRREAD Lib "RSAPI.DLL" (ByVal A$)
Declare Sub STRLENGTH Lib "RSAPI.DLL" (ByVal L%)
Declare Sub TIMEINIT Lib "RSAPI.DLL" ()
Declare Function TIMEREAD Lib "RSAPI.DLL" () As Long
Declare Sub SENDBYTE Lib "RSAPI.DLL" (ByVal B%)
Declare Function SENDSTRING Lib "RSAPI.DLL" (ByVal S As String) As Integer
Declare Function READBYTE Lib "RSAPI.DLL" () As Integer
Declare Sub DELAY Lib "RSAPI.DLL" (ByVal ms%)
Declare Sub DTR Lib "RSAPI.DLL" (Pegel As Integer)
Declare Sub RTS Lib "RSAPI.DLL" (Pegel As Integer)
Declare Sub TXD Lib "RSAPI.DLL" (Pegel As Integer)
Declare Function CTS Lib "RSAPI.DLL" () As Integer
Hauptteil
Sub Main()
Call Blatt_kw 'Eventuell neues Blatt anlegen
offset1 = 53 'StartZeile definieren 'Bis zum letzen Eintrag fahren
j = 0
While (Cells(j + offset1, 1) = "M" Or Cells(j + offset1, 1) = "A")
j = j + 1
Wend
' Werte erfassen
While Not KeyCode
OPENCOM "COM1:9600,n,8,2" ' Hier müssen die richtigen Parameter der Schnittstelle stehen
TIMEOUT 400
RTS 1 ' Notwendig, damit ein öffnen der Tür erkannt wird
DELAY 100
If CTS = 1 Then ' Automatische Messung Prüfstandstür ist geschlossen
Cells(j + offset1, 1) = "A"
Else 'Prüfstandstüre offen manuelle Messung
Cells(j + offset1, 1) = "M"
End If
messwert = Einezeile() 'Eine Zeile mit neuen Messwerten einlesen
' Zerlegung der Messwerte (dies ist ganz spezifisch und muß individuell angepasst werden)
Cells(j + offset1, 2) = Date ' Datum der Messung
Cells(j + offset1, 3) = Time ' Zeitstempel der Messung
Cells(j + offset1, 4) = Val(Mid(messwert, 2, 2)) 'Prüfprogrammstring "ausschneiden"
Cells(j + offset1, 5) = Mid(messwert, 8, 2) 'Ergebnisstring (PB=i.O.) "ausschneiden"
Cells(j + offset1, 6) = Val(Mid(messwert, 12, 7)) 'Messwertstring ausschneiden und umwandeln in einen Wert
Cells(j + offset1, 7) = Mid(messwert, 20, 3) 'Einheit (kPa)
' Chargen eintragen
For L = 0 To 11
Cells(j + offset1, 8 + L) = Cells(2 + L, 12)
Next L
' Messwerte in t- Zeile eintragen
t = 43 '
For L = 1 To 22
Cells(t, L) = Cells(j + offset1, L)
Next L
j = j + 1 ' Nächste j
RTS 0 ' Notwendig, damit ein öffnen der Tür erkannt wird
CLOSECOM 'Schnittstelle schließen
If j / 10 = Int(j / 10) Then ActiveWorkbook.Save ' Speichern nach 10 Messungen
Wend
CLOSECOM
End Sub
Function Einezeile() As String
' Liest eine Zeile mit Daten von der seriellen Schnittstelle ein und wandelt alle Byts, die höher als 128 sind um.
Alt$ = ""
K = 1
While True
e = READBYTE ' Byte einlesen
DELAY 10
' Blinkender Zähler zeigt, daß Messung Aktiv ist
If Cells(7, 14) = K Then Cells(7, 14) = " Messung aktiv " Else Cells(7, 14) = K
K = K + 1
If e > 127 Then e = e - 128 ' Nur die unteren 128 Zeichen werden benutzt
If e > -1 Then
A$ = Chr$(e)
Alt$ = Alt$ + A$ ' String zusammenbauen
End If
If e = -1 And Alt$ <> "" Then
Einezeile = Alt$
Exit Function
End If
If Len(Alt$) > 255 Then Alt$ = " " 'Absicherung gegen Überlauf
Wend
End Function
Sub Blatt_kw()'Erstellt eine neue Tabelle mit der aktuellen Kalenderwoche als Titel
gefunden = 0
For i = 1 To Sheets.Count
If "KW" & Str$(DatePart("ww", Date - 7)) = Sheets(i).Name Then gefunden = 1
Next i
If gefunden = 0 Then
' Arbeitsblatt hinzufügen
Sheets("Muster").Select
ActiveWorkbook.Sheets.Copy after:=Worksheets(Worksheets.Count)
Sheets("Muster (2)").Activate
Sheets("Muster (2)").Name = "KW" & Str$(DatePart("ww", Date - 7))
Else 'Arbeitsblatt ist vorhanden
Sheets("KW" & Str$(DatePart("ww", Date - 7))).Activate 'aktivieren
End If
End Sub
Sub test_schalter()
While Not esc
OPENCOM "COM1:9600,n,8,2"
RTS 1 ' Notwendig, damit ein öffnen der Tür erkannt wird
DELAY 100
If CTS = 1 Then ' Automatische Messung Prüfstandstür ist geschlossen
Cells(2, 1) = "A"
Else 'Prüfstandstüre offen
Cells(2, 1) = "M"
End If
CLOSECOM
Wend
End Sub