Hallo,
wer weiß, wie man in Excel externe Daten anzeigen kann, die über den COM-Port reinkommen? Angeblich kann man das mit VB oder einem Makro machen - wie?
herbert
Hallo Herbert,
ich habe gerade bei http://www.ActiveVB.de eine Lösung für Dich gefunden, die allerdings in einem Zip-File verpackt ist und VB6-Code beinhaltet, den Du dann nicht mit Excel öffnen kannst.
Der Code bei AVB ist aber Freeware, darf frei verwendet und weitergegeben werden, deshalb kann ich Dir den Code hier posten.
Allerdings ist der Code für VB6 gedacht, den Code der Form musst Du an VBA anpassen, die Form heiß eben nicht Form1, sondern Userform.
Code für die Form:
Option Explicit
Private Sub Empfangen\_Click()
Dim x As Long
Dim Text As String
x = Comm\_lesen\_32(Me![ID], Text)
Me![EmpfangenText] = Me![EmpfangenText] & Text
End Sub
Private Sub Löschen\_Click()
Me![EmpfangenText] = ""
End Sub
Private Sub Senden\_Click()
On Error GoTo Err\_Senden\_Click
Dim x As Long
x = Comm\_schreiben\_32(Me![ID], Me![SendText] & Chr(13) & Chr(10))
Exit\_Senden\_Click:
Exit Sub
Err\_Senden\_Click:
MsgBox Err.Description
Resume Exit\_Senden\_Click
End Sub
Private Sub Umschaltfl\_Comm\_Click()
If Me![Umschaltfl\_Comm].Default = False Then
Me![Umschaltfl\_Comm].Default = True
Me![ID] = Comm\_open\_32(Me![Def])
ComPort![Umschaltfl\_Comm].Caption = "Schließen"
ComPort.BackColor = &HC0E0FF
Else
Me![Umschaltfl\_Comm].Default = False
Me![ID] = Comm\_close\_32(Me![ID])
Me![Umschaltfl\_Comm].Caption = "Öffnen"
ComPort.BackColor = &H8000000F
End If
End Sub
Und nun noch ein Modul, das heißt hier: ‚ComPort.bas‘
Option Explicit
'\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
'Beschreibung:
'Funktionen zum schreiben und lesen über die Serielle Schnittstelle
'Comm\_open\_32 öffnet die Schnittstelle
'Comm\_lesen\_32 liest von der Schnittstelle
'Comm\_schreiben\_32 schreibt auf die Schnittstelle
'Comm\_close\_32 schließt die Schnittstelle
'
'Quellangaben:
' Dittrich: Visual Basic5, Programmiertechniken und Lösungen; Franzis'
'\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*\*
'API-Funktionen zum Verwalten des Dateisystems
'(ab Win95 werden die Schnittstellen (Seriel und Paralel wie Dateien behandelt!)
Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal NOlpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Const GENERIC\_READ = &H80000000
Const GENERIC\_WRITE = &H40000000
Const OPEN\_EXISTING = 3
Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As String, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal NOlpOverlapped As Long) As Long
Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, ByVal lpBuffer As String, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'\*\* Ein-/Ausgabepuffer setzen
Declare Function SetupComm Lib "kernel32" (ByVal hFile As Long, ByVal dwInQueue As Long, ByVal dwOutQueue As Long) As Long
'\*\* Device Control Block
Type DCBType
DCBlength As Long
BaudRate As Long
fBinary As Long
fParity As Long
fOutxCtsFlow As Long
fOutxDsrFlow As Long
fDtrControl As Long
fDsrSensitivity As Long
fTXContinueOnXoff As Long
fOutX As Long
fInX As Long
fErrorChar As Long
fNull As Long
fRtsControl As Long
fAbortOnError As Long
fDummy2 As Long
wReserved As Integer
XonLim As Integer
XoffLim As Integer
ByteSize As Byte
Parity As Byte
StopBits As Byte
XonChar As Byte
XoffChar As Byte
ErrorChar As Byte
EofChar As Byte
EvtChar As Byte
End Type
Declare Function BuildCommDCB Lib "kernel32" Alias "BuildCommDCBA" (ByVal lpDef As String, lpDCB As DCBType) As Long
Declare Function SetCommState Lib "kernel32" (ByVal hCommDev As Long, lpDCB As DCBType) As Long
Declare Function GetCommState Lib "kernel32" (ByVal nCid As Long, lpDCB As DCBType) As Long
'\*\* Status Abfrage
Declare Function ClearCommError Lib "kernel32" (ByVal hFile As Long, lpErrors As Long, lpStat As COMSTAT) As Long
Type COMSTAT
Bits As Long
cbInQue As Long
cbOutQue As Long
End Type
' Fehler-Flags
Const CE\_RXOVER = &H1 ' Überlauf der Empfangswarteschlange
Const CE\_OVERRUN = &H2 ' Überlauffehler beim Empfangen
Const CE\_RXPARITY = &H4 ' Paritätsfehler beim Empfangen
Const CE\_FRAME = &H8 ' Framing-Fehler beim Empfangen
Const CE\_BREAK = &H10 ' Unterbrechung entdeckt
Const CE\_CTSTO = &H20 ' CTS-Timeout
Const CE\_DSRTO = &H40 ' DSR-Timeout
Const CE\_RLSDTO = &H80 ' RLSD-Timeout
Const CE\_TXFULL = &H100 ' TX-Warteschlange ist voll
Const CE\_PTO = &H200 ' LPTx-Timeout
Const CE\_IOE = &H400 ' LPTx-E/A-Fehler
Const CE\_DNS = &H800 ' LPTx-Gerät nicht ausgewählt
Const CE\_OOP = &H1000 ' LPTx hat kein Papier mehr
Const CE\_MODE = &H8000 ' Angegebener Modus wird nicht unterstützt
'\*\* Einstellungs-Dialog einblenden
Declare Function CommConfigDialog Lib "kernel32" Alias "CommConfigDialogA" (ByVal lpszName As String, ByVal Hwnd As Long, lpCC As COMMCONFIG) As Long
Type COMMCONFIG
dwSize As Long
wVersion As Integer
wReserved As Integer
dcbx As DCBType
dwProviderSubType As Long
dwProviderOffset As Long
dwProviderSize As Long
wcProviderData As Byte
End Type
Function Comm\_close\_32(nCid As Integer)
'Schließt die Angegebene Schnittstelle
'Übergabewert: nCid = Identifizierungsnummer des Prots
'Gibt True zurück, wenn kein Fehler aufgetreten ist
On Error GoTo Err\_Comm\_close\_32
Dim x As Integer
Dim Erg As Integer
x = CloseHandle(nCid)
If x 0 Then
' Error 1
'End If
If nStat.cbInQue \> 0 Then
lpBuf = String$(nStat.cbInQue, 0)
x = ReadFile(nCid, lpBuf, Len(lpBuf), Anzahl, 0)
End If
Exit\_Comm\_lesen\_32:
Text = lpBuf
Comm\_lesen\_32 = x
Exit Function
Err\_Comm\_lesen\_32:
MsgBox "Fehler in Function Comm\_lesen\_32: " & Error$
lpBuf = ""
x = -1
Resume Exit\_Comm\_lesen\_32
End Function
Function Comm\_open\_32(ByVal Port\_Def As String) As Integer
'Öffnet die Serielle Schnittstelle und initialisiert sie gem. Port\_Def (z.B.: "COM2:48,N,8,1")
'Rückgabewert:
'Identifizierungsnummer des Prots
'ACHTUNG: Auch 0 ist eine gültige Nummer
'Bei FEHLER wird ein Wert
Ich hoffe, damit kannst Du etwas anfangen.
Gruß, Rainer
Hallo Rainer
besten Dank, das werde ich gleich mal testen
herbert