Introduzione alla Comunicazione su porta seriale in VBA
Lo scopo di questo articolo è dimostrare come sia possibile stabilire un canale di comunicazione attraverso la porta seriale utilizzando VBA (Visual Basic Applications - un editor di script incluso in ogni distribuzione tipica di Microsoft Excel) evitando di utilizzare controlli come MSComm o ActiveX o applicazioni di terze parti. Il grande vantaggio di questo metodo (che utilizza funzioni API per effettuare chiamate direttamente alla porta seriale) sta nel fatto che non è necessario installare sul PC nessun tipo di programma oltre ad Excel (tipicamente già installato nella maggior parte dei computer). Altri metodi diversi da questo richiedono solitamente l'installazione di un ActiveX, o per lo meno la registrazione di un file ".ocx", come avviene per esempio con il controllo MSComm.
Anche nel caso si utilizzasse la programmazione in C#, come da me suggerito in un altro articolo (Comunicazione via porta seriale in C#), sarebbe necessario installare il Framework .NET e il compilatore C#.
Si dà per scontato che il lettore abbia una nozione base di programmazione (molto base, non è necessario avere grande esperienza come programmatore).
Per poter accedere all'editor degli script in VBA, è necessario prima rendere visibili i pulsanti corrispondenti all'interno della barra degli strumenti di Excel (non sono visibili di default). Una volta avviato Excel, scegliete dalla barra dei menu Visualizza -> Barre degli Strumenti -> Visual Basic. Questo processo renderà visibile una finestra strumenti aggiuntiva, con i seguenti pulsanti:
Questi pulsanti permetteranno l'avvio dell'editor in cui potrete scrivere il codice Visual Basic e creare controlli tipo caselle di testo, pulsanti, etichette, pulsanti radio, checkbox ecc.
Per attivare questi controlli, è necessario abilitare il pulsante Controllo Casella Strumenti, incluso nella finestra strumenti precedentemente attivata.
Questo passo renderà disponibile una serie di altri pulsanti che permetteranno l'impostazione dei seguenti controlli:
L'obiettivo di questo articolo è dimostrare come abilitare una porta seriale, scrivere alcuni bytes, leggere alcuni bytes e successivamente disabilitare la porta stessa. Per raggiungere questo scopo, sarà necessario creare quattro pulsanti, ognuno dei quali eseguirà uno dei passi appena elencati.
Premete l'opzione Pulsante Comandi nel menu precedentemente abilitato, e successivamente disegnate 4 pulsanti all'interno del vostro foglio di lavoro Excel (potrebbe risultare impegnativo disegnarli tutti delle stesse dimensioni!):
Una volta pronti, premete il tasto Visual Basic Editor nella barra strumenti prima attivata.
Si aprirà a questo punto l'ambiente in cui potrete scrivere il codice per gli script Visual Basic che eseguiranno le varie operazioni. Assicuratevi di avere selezionato la voce Foglio1 nella finestra di gestione del progetto:
Questa azione provocherà l'apertura del foglio di lavoro in cui scriverete il codice VB; il foglio si aprirà nella finestra principale dell'ambiente. Una volta giunti a questo punto, copiate ed incollate il codice che trovate qui sotto. Questo codice Visual Basic "definisce" le costanti, le strutture e le funzioni API che useremo poi per eseguire le varie operazioni. I commenti nel codice sono auto-esplicativi. L'articolo continua alla fine del codice, quindi siete pregati di scorrere la finestra.
Script di Comunicazione della Porta Seriale
Option Explicit '------------------------------------------------------------------------------- ' ' This VB module is a collection of routines to perform serial port I/O without ' using the Microsoft Comm Control component. This module uses the Windows API ' to perform the overlapped I/O operations necessary for serial communications. ' ' The routine can handle up to 4 serial ports which are identified with a ' Port ID. ' ' All routines (with the exception of CommRead and CommWrite) return an error ' code or 0 if no error occurs. The routine CommGetError can be used to get ' the complete error message. '------------------------------------------------------------------------------- '------------------------------------------------------------------------------- ' Public Constants '------------------------------------------------------------------------------- ' Output Control Lines (CommSetLine) Const LINE_BREAK = 1 Const LINE_DTR = 2 Const LINE_RTS = 3 ' Input Control Lines (CommGetLine) Const LINE_CTS = &H10& Const LINE_DSR = &H20& Const LINE_RING = &H40& Const LINE_RLSD = &H80& Const LINE_CD = &H80& '------------------------------------------------------------------------------- ' System Constants '------------------------------------------------------------------------------- Private Const ERROR_IO_INCOMPLETE = 996& Private Const ERROR_IO_PENDING = 997 Private Const GENERIC_READ = &H80000000 Private Const GENERIC_WRITE = &H40000000 Private Const FILE_ATTRIBUTE_NORMAL = &H80 Private Const FILE_FLAG_OVERLAPPED = &H40000000 Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000 Private Const OPEN_EXISTING = 3 ' COMM Functions Private Const MS_CTS_ON = &H10& Private Const MS_DSR_ON = &H20& Private Const MS_RING_ON = &H40& Private Const MS_RLSD_ON = &H80& Private Const PURGE_RXABORT = &H2 Private Const PURGE_RXCLEAR = &H8 Private Const PURGE_TXABORT = &H1 Private Const PURGE_TXCLEAR = &H4 ' COMM Escape Functions Private Const CLRBREAK = 9 Private Const CLRDTR = 6 Private Const CLRRTS = 4 Private Const SETBREAK = 8 Private Const SETDTR = 5 Private Const SETRTS = 3 '------------------------------------------------------------------------------- ' System Structures '------------------------------------------------------------------------------- Private Type COMSTAT fBitFields As Long ' See Comment in Win32API.Txt cbInQue As Long cbOutQue As Long End Type Private Type COMMTIMEOUTS ReadIntervalTimeout As Long ReadTotalTimeoutMultiplier As Long ReadTotalTimeoutConstant As Long WriteTotalTimeoutMultiplier As Long WriteTotalTimeoutConstant As Long End Type ' ' The DCB structure defines the control setting for a serial ' communications device. ' Private Type DCB DCBlength As Long BaudRate As Long fBitFields As Long ' See Comments in Win32API.Txt 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 wReserved1 As Integer 'Reserved; Do Not Use End Type Private Type OVERLAPPED Internal As Long InternalHigh As Long offset As Long OffsetHigh As Long hEvent As Long End Type Private Type SECURITY_ATTRIBUTES nLength As Long lpSecurityDescriptor As Long bInheritHandle As Long End Type '------------------------------------------------------------------------------- ' System Functions '------------------------------------------------------------------------------- ' ' Fills a specified DCB structure with values specified in ' a device-control string. ' Private Declare Function BuildCommDCB Lib "kernel32" Alias "BuildCommDCBA" _ (ByVal lpDef As String, lpDCB As DCB) As Long ' ' Retrieves information about a communications error and reports ' the current status of a communications device. The function is ' called when a communications error occurs, and it clears the ' device's error flag to enable additional input and output ' (I/O) operations. ' Private Declare Function ClearCommError Lib "kernel32" _ (ByVal hFile As Long, lpErrors As Long, lpStat As COMSTAT) As Long ' ' Closes an open communications device or file handle. ' Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long ' ' Creates or opens a communications resource and returns a handle ' that can be used to access the resource. ' Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" _ (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, _ ByVal dwShareMode As Long, lpSecurityAttributes As Any, _ ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, _ ByVal hTemplateFile As Long) As Long ' ' Directs a specified communications device to perform a function. ' Private Declare Function EscapeCommFunction Lib "kernel32" _ (ByVal nCid As Long, ByVal nFunc As Long) As Long ' ' Formats a message string such as an error string returned ' by anoher function. ' Private Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" _ (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, _ ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, _ Arguments As Long) As Long ' ' Retrieves modem control-register values. ' Private Declare Function GetCommModemStatus Lib "kernel32" _ (ByVal hFile As Long, lpModemStat As Long) As Long ' ' Retrieves the current control settings for a specified ' communications device. ' Private Declare Function GetCommState Lib "kernel32" _ (ByVal nCid As Long, lpDCB As DCB) As Long ' ' Retrieves the calling thread's last-error code value. ' Private Declare Function GetLastError Lib "kernel32" () As Long ' ' Retrieves the results of an overlapped operation on the ' specified file, named pipe, or communications device. ' Private Declare Function GetOverlappedResult Lib "kernel32" _ (ByVal hFile As Long, lpOverlapped As OVERLAPPED, _ lpNumberOfBytesTransferred As Long, ByVal bWait As Long) As Long ' ' Discards all characters from the output or input buffer of a ' specified communications resource. It can also terminate ' pending read or write operations on the resource. ' Private Declare Function PurgeComm Lib "kernel32" _ (ByVal hFile As Long, ByVal dwFlags As Long) As Long ' ' Reads data from a file, starting at the position indicated by the ' file pointer. After the read operation has been completed, the ' file pointer is adjusted by the number of bytes actually read, ' unless the file handle is created with the overlapped attribute. ' If the file handle is created for overlapped input and output ' (I/O), the application must adjust the position of the file pointer ' after the read operation. ' Private Declare Function ReadFile Lib "kernel32" _ (ByVal hFile As Long, ByVal lpBuffer As String, _ ByVal nNumberOfBytesToRead As Long, ByRef lpNumberOfBytesRead As Long, _ lpOverlapped As OVERLAPPED) As Long ' ' Configures a communications device according to the specifications ' in a device-control block (a DCB structure). The function ' reinitializes all hardware and control settings, but it does not ' empty output or input queues. ' Private Declare Function SetCommState Lib "kernel32" _ (ByVal hCommDev As Long, lpDCB As DCB) As Long ' ' Sets the time-out parameters for all read and write operations on a ' specified communications device. ' Private Declare Function SetCommTimeouts Lib "kernel32" _ (ByVal hFile As Long, lpCommTimeouts As COMMTIMEOUTS) As Long ' ' Initializes the communications parameters for a specified ' communications device. ' Private Declare Function SetupComm Lib "kernel32" _ (ByVal hFile As Long, ByVal dwInQueue As Long, ByVal dwOutQueue As Long) As Long ' ' Writes data to a file and is designed for both synchronous and a ' synchronous operation. The function starts writing data to the file ' at the position indicated by the file pointer. After the write ' operation has been completed, the file pointer is adjusted by the ' number of bytes actually written, except when the file is opened with ' FILE_FLAG_OVERLAPPED. If the file handle was created for overlapped ' input and output (I/O), the application must adjust the position of ' the file pointer after the write operation is finished. ' Private Declare Function WriteFile Lib "kernel32" _ (ByVal hFile As Long, ByVal lpBuffer As String, _ ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, _ lpOverlapped As OVERLAPPED) As Long Private Declare Sub AppSleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long) '------------------------------------------------------------------------------- ' Program Constants '------------------------------------------------------------------------------- Private Const MAX_PORTS = 4 '------------------------------------------------------------------------------- ' Program Structures '------------------------------------------------------------------------------- Private Type COMM_ERROR lngErrorCode As Long strFunction As String strErrorMessage As String End Type Private Type COMM_PORT lngHandle As Long blnPortOpen As Boolean udtDCB As DCB End Type '------------------------------------------------------------------------------- ' Program Storage '------------------------------------------------------------------------------- Private udtCommOverlap As OVERLAPPED Private udtCommError As COMM_ERROR Private udtPorts(1 To MAX_PORTS) As COMM_PORT '------------------------------------------------------------------------------- ' GetSystemMessage - Gets system error text for the specified error code. '------------------------------------------------------------------------------- Public Function GetSystemMessage(lngErrorCode As Long) As String Dim intPos As Integer Dim strMessage As String, strMsgBuff As String * 256 Call FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0, lngErrorCode, 0, strMsgBuff, 255, 0) intPos = InStr(1, strMsgBuff, vbNullChar) If intPos > 0 Then strMessage = Trim$(Left$(strMsgBuff, intPos - 1)) Else strMessage = Trim$(strMsgBuff) End If GetSystemMessage = strMessage End Function Public Function PauseApp(PauseInSeconds As Long) Call AppSleep(PauseInSeconds * 1000) End Function '------------------------------------------------------------------------------- ' CommOpen - Opens/Initializes serial port. ' ' ' Parameters: ' intPortID - Port ID used when port was opened. ' strPort - COM port name. (COM1, COM2, COM3, COM4) ' strSettings - Communication settings. ' Example: "baud=9600 parity=N data=8 stop=1" ' ' Returns: ' Error Code - 0 = No Error. ' '------------------------------------------------------------------------------- Public Function CommOpen(intPortID As Integer, strPort As String, _ strSettings As String) As Long Dim lngStatus As Long Dim udtCommTimeOuts As COMMTIMEOUTS On Error GoTo Routine_Error ' See if port already in use. If udtPorts(intPortID).blnPortOpen Then lngStatus = -1 With udtCommError .lngErrorCode = lngStatus .strFunction = "CommOpen" .strErrorMessage = "Port in use." End With GoTo Routine_Exit End If ' Open serial port. udtPorts(intPortID).lngHandle = CreateFile(strPort, GENERIC_READ Or _ GENERIC_WRITE, 0, ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0) If udtPorts(intPortID).lngHandle = -1 Then lngStatus = SetCommError("CommOpen (CreateFile)") GoTo Routine_Exit End If udtPorts(intPortID).blnPortOpen = True ' Setup device buffers (1K each). lngStatus = SetupComm(udtPorts(intPortID).lngHandle, 1024, 1024) If lngStatus = 0 Then lngStatus = SetCommError("CommOpen (SetupComm)") GoTo Routine_Exit End If ' Purge buffers. lngStatus = PurgeComm(udtPorts(intPortID).lngHandle, PURGE_TXABORT Or _ PURGE_RXABORT Or PURGE_TXCLEAR Or PURGE_RXCLEAR) If lngStatus = 0 Then lngStatus = SetCommError("CommOpen (PurgeComm)") GoTo Routine_Exit End If ' Set serial port timeouts. With udtCommTimeOuts .ReadIntervalTimeout = -1 .ReadTotalTimeoutMultiplier = 0 .ReadTotalTimeoutConstant = 1000 .WriteTotalTimeoutMultiplier = 0 .WriteTotalTimeoutMultiplier = 1000 End With lngStatus = SetCommTimeouts(udtPorts(intPortID).lngHandle, udtCommTimeOuts) If lngStatus = 0 Then lngStatus = SetCommError("CommOpen (SetCommTimeouts)") GoTo Routine_Exit End If ' Get the current state (DCB). lngStatus = GetCommState(udtPorts(intPortID).lngHandle, _ udtPorts(intPortID).udtDCB) If lngStatus = 0 Then lngStatus = SetCommError("CommOpen (GetCommState)") GoTo Routine_Exit End If ' Modify the DCB to reflect the desired settings. lngStatus = BuildCommDCB(strSettings, udtPorts(intPortID).udtDCB) If lngStatus = 0 Then lngStatus = SetCommError("CommOpen (BuildCommDCB)") GoTo Routine_Exit End If ' Set the new state. lngStatus = SetCommState(udtPorts(intPortID).lngHandle, _ udtPorts(intPortID).udtDCB) If lngStatus = 0 Then lngStatus = SetCommError("CommOpen (SetCommState)") GoTo Routine_Exit End If lngStatus = 0 Routine_Exit: CommOpen = lngStatus Exit Function Routine_Error: lngStatus = Err.Number With udtCommError .lngErrorCode = lngStatus .strFunction = "CommOpen" .strErrorMessage = Err.Description End With Resume Routine_Exit End Function Private Function SetCommError(strFunction As String) As Long With udtCommError .lngErrorCode = Err.LastDllError .strFunction = strFunction .strErrorMessage = GetSystemMessage(.lngErrorCode) SetCommError = .lngErrorCode End With End Function Private Function SetCommErrorEx(strFunction As String, lngHnd As Long) As Long Dim lngErrorFlags As Long Dim udtCommStat As COMSTAT With udtCommError .lngErrorCode = GetLastError .strFunction = strFunction .strErrorMessage = GetSystemMessage(.lngErrorCode) Call ClearCommError(lngHnd, lngErrorFlags, udtCommStat) .strErrorMessage = .strErrorMessage & " COMM Error Flags = " & _ Hex$(lngErrorFlags) SetCommErrorEx = .lngErrorCode End With End Function '------------------------------------------------------------------------------- ' CommSet - Modifies the serial port settings. ' ' Parameters: ' intPortID - Port ID used when port was opened. ' strSettings - Communication settings. ' Example: "baud=9600 parity=N data=8 stop=1" ' ' Returns: ' Error Code - 0 = No Error. '------------------------------------------------------------------------------- Public Function CommSet(intPortID As Integer, strSettings As String) As Long Dim lngStatus As Long On Error GoTo Routine_Error lngStatus = GetCommState(udtPorts(intPortID).lngHandle, _ udtPorts(intPortID).udtDCB) If lngStatus = 0 Then lngStatus = SetCommError("CommSet (GetCommState)") GoTo Routine_Exit End If lngStatus = BuildCommDCB(strSettings, udtPorts(intPortID).udtDCB) If lngStatus = 0 Then lngStatus = SetCommError("CommSet (BuildCommDCB)") GoTo Routine_Exit End If lngStatus = SetCommState(udtPorts(intPortID).lngHandle, _ udtPorts(intPortID).udtDCB) If lngStatus = 0 Then lngStatus = SetCommError("CommSet (SetCommState)") GoTo Routine_Exit End If lngStatus = 0 Routine_Exit: CommSet = lngStatus Exit Function Routine_Error: lngStatus = Err.Number With udtCommError .lngErrorCode = lngStatus .strFunction = "CommSet" .strErrorMessage = Err.Description End With Resume Routine_Exit End Function '------------------------------------------------------------------------------- ' CommClose - Close the serial port. ' ' Parameters: ' intPortID - Port ID used when port was opened. ' ' Returns: ' Error Code - 0 = No Error. '------------------------------------------------------------------------------- Public Function CommClose(intPortID As Integer) As Long Dim lngStatus As Long On Error GoTo Routine_Error If udtPorts(intPortID).blnPortOpen Then lngStatus = CloseHandle(udtPorts(intPortID).lngHandle) If lngStatus = 0 Then lngStatus = SetCommError("CommClose (CloseHandle)") GoTo Routine_Exit End If udtPorts(intPortID).blnPortOpen = False End If lngStatus = 0 Routine_Exit: CommClose = lngStatus Exit Function Routine_Error: lngStatus = Err.Number With udtCommError .lngErrorCode = lngStatus .strFunction = "CommClose" .strErrorMessage = Err.Description End With Resume Routine_Exit End Function '------------------------------------------------------------------------------- ' CommFlush - Flush the send and receive serial port buffers. ' ' Parameters: ' intPortID - Port ID used when port was opened. ' ' Returns: ' Error Code - 0 = No Error. '------------------------------------------------------------------------------- Public Function CommFlush(intPortID As Integer) As Long Dim lngStatus As Long On Error GoTo Routine_Error lngStatus = PurgeComm(udtPorts(intPortID).lngHandle, PURGE_TXABORT Or _ PURGE_RXABORT Or PURGE_TXCLEAR Or PURGE_RXCLEAR) If lngStatus = 0 Then lngStatus = SetCommError("CommFlush (PurgeComm)") GoTo Routine_Exit End If lngStatus = 0 Routine_Exit: CommFlush = lngStatus Exit Function Routine_Error: lngStatus = Err.Number With udtCommError .lngErrorCode = lngStatus .strFunction = "CommFlush" .strErrorMessage = Err.Description End With Resume Routine_Exit End Function '------------------------------------------------------------------------------- ' CommRead - Read serial port input buffer. ' ' Parameters: ' intPortID - Port ID used when port was opened. ' strData - Data buffer. ' lngSize - Maximum number of bytes to be read. ' ' Returns: ' Error Code - 0 = No Error. '------------------------------------------------------------------------------- Public Function CommRead(intPortID As Integer, strData As String, _ lngSize As Long) As Long Dim lngStatus As Long Dim lngRdSize As Long, lngBytesRead As Long Dim lngRdStatus As Long, strRdBuffer As String * 1024 Dim lngErrorFlags As Long, udtCommStat As COMSTAT On Error GoTo Routine_Error strData = "" lngBytesRead = 0 DoEvents ' Clear any previous errors and get current status. lngStatus = ClearCommError(udtPorts(intPortID).lngHandle, lngErrorFlags, _ udtCommStat) If lngStatus = 0 Then lngBytesRead = -1 lngStatus = SetCommError("CommRead (ClearCommError)") GoTo Routine_Exit End If If udtCommStat.cbInQue > 0 Then If udtCommStat.cbInQue > lngSize Then lngRdSize = udtCommStat.cbInQue Else lngRdSize = lngSize End If Else lngRdSize = 0 End If If lngRdSize Then lngRdStatus = ReadFile(udtPorts(intPortID).lngHandle, strRdBuffer, _ lngRdSize, lngBytesRead, udtCommOverlap) If lngRdStatus = 0 Then lngStatus = GetLastError If lngStatus = ERROR_IO_PENDING Then ' Wait for read to complete. ' This function will timeout according to the ' COMMTIMEOUTS.ReadTotalTimeoutConstant variable. ' Every time it times out, check for port errors. ' Loop until operation is complete. While GetOverlappedResult(udtPorts(intPortID).lngHandle, _ udtCommOverlap, lngBytesRead, True) = 0 lngStatus = GetLastError If lngStatus <> ERROR_IO_INCOMPLETE Then lngBytesRead = -1 lngStatus = SetCommErrorEx( _ "CommRead (GetOverlappedResult)", _ udtPorts(intPortID).lngHandle) GoTo Routine_Exit End If Wend Else ' Some other error occurred. lngBytesRead = -1 lngStatus = SetCommErrorEx("CommRead (ReadFile)", _ udtPorts(intPortID).lngHandle) GoTo Routine_Exit End If End If strData = Left$(strRdBuffer, lngBytesRead) End If Routine_Exit: CommRead = lngBytesRead Exit Function Routine_Error: lngBytesRead = -1 lngStatus = Err.Number With udtCommError .lngErrorCode = lngStatus .strFunction = "CommRead" .strErrorMessage = Err.Description End With Resume Routine_Exit End Function '------------------------------------------------------------------------------- ' CommWrite - Output data to the serial port. ' ' Parameters: ' intPortID - Port ID used when port was opened. ' strData - Data to be transmitted. ' ' Returns: ' Error Code - 0 = No Error. '------------------------------------------------------------------------------- Public Function CommWrite(intPortID As Integer, strData As String) As Long Dim i As Integer Dim lngStatus As Long, lngSize As Long Dim lngWrSize As Long, lngWrStatus As Long On Error GoTo Routine_Error ' Get the length of the data. lngSize = Len(strData) ' Output the data. lngWrStatus = WriteFile(udtPorts(intPortID).lngHandle, strData, lngSize, _ lngWrSize, udtCommOverlap) ' Note that normally the following code will not execute because the driver ' caches write operations. Small I/O requests (up to several thousand bytes) ' will normally be accepted immediately and WriteFile will return true even ' though an overlapped operation was specified. DoEvents If lngWrStatus = 0 Then lngStatus = GetLastError If lngStatus = 0 Then GoTo Routine_Exit ElseIf lngStatus = ERROR_IO_PENDING Then ' We should wait for the completion of the write operation so we know ' if it worked or not. ' ' This is only one way to do this. It might be beneficial to place the ' writing operation in a separate thread so that blocking on completion ' will not negatively affect the responsiveness of the UI. ' ' If the write takes long enough to complete, this function will timeout ' according to the CommTimeOuts.WriteTotalTimeoutConstant variable. ' At that time we can check for errors and then wait some more. ' Loop until operation is complete. While GetOverlappedResult(udtPorts(intPortID).lngHandle, _ udtCommOverlap, lngWrSize, True) = 0 lngStatus = GetLastError If lngStatus <> ERROR_IO_INCOMPLETE Then lngStatus = SetCommErrorEx( _ "CommWrite (GetOverlappedResult)", _ udtPorts(intPortID).lngHandle) GoTo Routine_Exit End If Wend Else ' Some other error occurred. lngWrSize = -1 lngStatus = SetCommErrorEx("CommWrite (WriteFile)", _ udtPorts(intPortID).lngHandle) GoTo Routine_Exit End If End If For i = 1 To 10 DoEvents Next Routine_Exit: CommWrite = lngWrSize Exit Function Routine_Error: lngStatus = Err.Number With udtCommError .lngErrorCode = lngStatus .strFunction = "CommWrite" .strErrorMessage = Err.Description End With Resume Routine_Exit End Function '------------------------------------------------------------------------------- ' CommGetLine - Get the state of selected serial port control lines. ' ' Parameters: ' intPortID - Port ID used when port was opened. ' intLine - Serial port line. CTS, DSR, RING, RLSD (CD) ' blnState - Returns state of line (Cleared or Set). ' ' Returns: ' Error Code - 0 = No Error. '------------------------------------------------------------------------------- Public Function CommGetLine(intPortID As Integer, intLine As Integer, _ blnState As Boolean) As Long Dim lngStatus As Long Dim lngComStatus As Long, lngModemStatus As Long On Error GoTo Routine_Error lngStatus = GetCommModemStatus(udtPorts(intPortID).lngHandle, lngModemStatus) If lngStatus = 0 Then lngStatus = SetCommError("CommReadCD (GetCommModemStatus)") GoTo Routine_Exit End If If (lngModemStatus And intLine) Then blnState = True Else blnState = False End If lngStatus = 0 Routine_Exit: CommGetLine = lngStatus Exit Function Routine_Error: lngStatus = Err.Number With udtCommError .lngErrorCode = lngStatus .strFunction = "CommReadCD" .strErrorMessage = Err.Description End With Resume Routine_Exit End Function '------------------------------------------------------------------------------- ' CommSetLine - Set the state of selected serial port control lines. ' ' Parameters: ' intPortID - Port ID used when port was opened. ' intLine - Serial port line. BREAK, DTR, RTS ' Note: BREAK actually sets or clears a "break" condition on ' the transmit data line. ' blnState - Sets the state of line (Cleared or Set). ' ' Returns: ' Error Code - 0 = No Error. '------------------------------------------------------------------------------- Public Function CommSetLine(intPortID As Integer, intLine As Integer, _ blnState As Boolean) As Long Dim lngStatus As Long Dim lngNewState As Long On Error GoTo Routine_Error If intLine = LINE_BREAK Then If blnState Then lngNewState = SETBREAK Else lngNewState = CLRBREAK End If ElseIf intLine = LINE_DTR Then If blnState Then lngNewState = SETDTR Else lngNewState = CLRDTR End If ElseIf intLine = LINE_RTS Then If blnState Then lngNewState = SETRTS Else lngNewState = CLRRTS End If End If lngStatus = EscapeCommFunction(udtPorts(intPortID).lngHandle, lngNewState) If lngStatus = 0 Then lngStatus = SetCommError("CommSetLine (EscapeCommFunction)") GoTo Routine_Exit End If lngStatus = 0 Routine_Exit: CommSetLine = lngStatus Exit Function Routine_Error: lngStatus = Err.Number With udtCommError .lngErrorCode = lngStatus .strFunction = "CommSetLine" .strErrorMessage = Err.Description End With Resume Routine_Exit End Function '------------------------------------------------------------------------------- ' CommGetError - Get the last serial port error message. ' ' Parameters: ' strMessage - Error message from last serial port error. ' ' Returns: ' Error Code - Last serial port error code. '------------------------------------------------------------------------------- Public Function CommGetError(strMessage As String) As Long With udtCommError CommGetError = .lngErrorCode strMessage = "Error (" & CStr(.lngErrorCode) & "): " & .strFunction & _ " - " & .strErrorMessage End With End Function
So che il codice può sembrare lungo e complesso, ma non ve ne dovete preoccupare. Esso infatti implementa molte più funzioni di quelle a voi necessarie. Alcune di esse, ad esempio, sono utilizzate per impostare le linee di controllo della porta seriale in modalità high/low (DTR, RTS) o per leggere lo stato delle altre linee di controllo (CTS, DSR). Le effettive funzioni di lettura/scrittura su porta seriale (anche'esse definite nel precedente codice) effettuano chiamate ad altre funzioni, ma questi processi non sono importanti per l'utente finale. Se siete arrivati fino a qui... beh avete già svolto metà del lavoro!
Assicuratevi di salvare il file (premendo il tasto "Salva") e poi tornate al foglio di lavoro excel, dove ritrovate i 4 tasti da voi disegnati pronti per essere configurati. Prima di tutto, accertatevi che il tasto "Modalità Design" sia attivato nella seconda barra degli strumenti che avete aggiunto prima:
Ora potete assegnare i nomi ad ognuno dei pulsanti che avete creato. Per farlo, premete il tasto destro del mouse sul primo pulsante, e dal menu a comparsa scegliete l'opzione Proprietà:
Apparirà una finestra con tutte le proprietà dell'oggetto che avete selezionato. Modificate la proprietà Caption in "Initialise" e chiudete la finestra. Questo cambierà l'etichetta del primo pulsante come in figura:
Ripetete lo stesso procedimento per ognuno degli altri pulsanti, assegnando le etichette "Write", "Read" e "Close".
Ora è tempo di aggiungere il codice ad ogni tasto. Premete col tasto destro del mouse sul primo pulsante da voi creato e dal menu a comparsa selezionate l'opzione Mostra Codice:
Si aprirà nuovamente l'ambiente di scripting, il quale aggiungerà una nuova funzione al codice; questa parte segnalerà l'inizio della funzione:
Private Sub CommandButton1_Click() End Sub
È qui che scriverete il codice per inizializzare la porta seriale. Per questa operazione useremo il comando CommOpen, precedentemente definito, che chiede come parametri l'ID della porta COM che volete abilitare (COM1, COM2 ecc.) e alcune stringhe che definiscono il baud rate, la parità ed il numero di bit dati e stop. Il codice necessario per questa operazione è il seguente:
Private Sub CommandButton1_Click() Dim intPortID As Integer ' Ex. 1, 2, 3, 4 for COM1 - COM4 Dim lngStatus As Long intPortID = 1 ' Open COM port lngStatus = CommOpen(intPortID, "COM" & CStr(intPortID), _ "baud=9600 parity=N data=8 stop=1") End Sub
Esso apre la COM1, con un baud rate di 9600, nessuna parità, 8 bit di dati e un bit di stop. Il numero della porta COM è specificato dal valore assegnato alla variabile intPortID. La variabile lngStatus conterrà il valore restituito dalla funzione CommOpen, e indicherà se la porta è stata aperta con successo o se è stato riscontrato un errore di qualche tipo.
Una volta completata questa funzione, ritornate al foglio excel, e con lo stesso procedimento (tasto destro e Visualizza Codice) create la funzione per il secondo pulsante, quello con l'etichetta "Write". Il codice per questa funzione è il seguente:
Private Sub CommandButton2_Click() Dim intPortID As Integer ' Ex. 1, 2, 3, 4 for COM1 - COM4 Dim lngStatus As Long Dim strData As String intPortID = 1 strData = "*IDN?;" 'Writa data lngStatus = CommWrite(intPortID, strData) End Sub
Questo codice effettua una chiamata alla funzione CommWrite, che accetta due parametri; il numero della porta COM su cui scrivere (deve essere lo stesso della porta che avete aperto con la precedente funzione CommOpen) e una stringa di caratteri che verrà inviata alla porta seriale. In questo caso, la variabile intPortID specifica che stiamo lavorando con la COM1, mentre i dati da inviare verranno memorizzati nella variabile strData (la stringa seguente d'esempio è particolare essendo una stringa di comando per un'unità di alimentazione programmabile che abbiamo in laboratorio; in pratica interroga l'unità di alimentazione riguardo al suo numero identificativo)
Ancora una volta, la variabile lngStatus indicherà se la scrittura è terminata con successo o se si è verificato un errore.
Nello stesso modo create e aggiungete il codice al terzo pulsante:
Private Sub CommandButton3_Click() Dim intPortID As Integer ' Ex. 1, 2, 3, 4 for COM1 - COM4 Dim lngStatus As Long Dim strData As String intPortID = 1 lngStatus = CommRead(intPortID, strData, 10) End Sub
Questo codice cercherà di leggere 10 caratteri dalla COM1 e memorizzarli nella variabile strData. Quando i dati sono memorizzati è possibile utilizzarli in qualsiasi modo: inserirli in una tabella, scriverli in una cella del foglio di lavoro, inserirli in un altro algoritmo in VB ecc.
Il prossimo passo logico è la chiusura della comunicazione con la porta seriale; per far questo, dovreste creare la funzione appropriata associandola al quarto pulsante che avete creato:
Private Sub CommandButton4_Click() Dim intPortID As Integer ' Ex. 1, 2, 3, 4 for COM1 - COM4 intPortID = 1 Call CommClose(intPortID) End Sub
Ricordatevi che VBA per excel è più un interprete che un compilatore. Questo significa che una volta scritto il codice, non avete bisogno di compilarlo, dovete solo eseguire lo script. Quando eseguite il codice assicuratevi sempre che il pulsante "Modalità Design" non sia attivo (il pulsante si trova nella seconda barra degli strumenti che avete aggiunto):
Una volta ultimato questo passo, potete proseguire premendo i pulsanti che avete creato; ogni volta che premete un di essi, il codice proveniente dalla funzione corrispondente verrà eseguito. Ovviamente dovreste premere i pulsanti nell'ordine logico che abbiamo precedentemente discusso. Per prima cosa inizializzate la porta, poi scrivete qualcosa sulla stessa. Se avete una periferica collegata alla porta seriale del vostro PC, potete provare a leggere 10 caratteri da essa; altrimenti proseguite chiudendo la porta.
Per favore tenete presente che non ho scritto queste funzioni di mio pugno. Questo è codice open source trovato su internet con il tempo e la pazienza necessari per la ricerca (spero di esser stato di aiuto con questo articolo). Non sono un programmatore professionista, e quindi non posso spiegarvi con chiarezza ogni parte di questo codice. Però, io stesso ho creato un file di test in excel e sono stato in grado di utilizzare con successo il codice riuscendo a comunicare con un'unità di alimentazione programmabile TTI.
Secondo il mio parere, il metodo di comunicazione su porta seriale ha dei vantaggi: non c'è necessità di installare programmi sul PC, e qualche volta i dati letti dalla porta seriale devono essere integrati in tabelle o grafici (operazione semplice da eseguire con excel). Sono però presenti anche dei contro: mancanza di un vero compilatore, lenta velocità di esecuzione, e l'impossibilità di poter programmare in linguaggi come C#, ad esempio.
Pezzo di codice eccezionale! Non so come avrei fatto senza.
Una piccola nota: mi capita spesso che durante la programmazione di excel, il codice mi dia errore. In questi casi può essere necessario riavviare excel perché la seriale rimane aperta e il successivo commOpen comunica “accesso negato”
X ovviare al problema ho effettuato la seguente modifica.
da:
udtPorts(intPortID).lngHandle = CreateFile(strPort, GENERIC_READ Or GENERIC_WRITE, 0, ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
a:
udtPorts(intPortID).lngHandle = CreateFile(strPort, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
Aggiungendo le costanti:
Private Const FILE_SHARE_READ = 1
Private Const FILE_SHARE_WRITE = 2
Private Const CREATE_ALWAYS = 2
Saluti