Le code ci-dessous permet le pilotage d'une balance via le port RS232

Auteur :

Jean-Yves GROSEIL
Société R:SOFT
Boulogne-Billancourt (92)
JYGros(at)aol.com

Pour pouvoir piloter une sortie série RS232 il faut :

• Disposer de l'ActiveX : MSComm32.ocx (Microsoft Communications Controls 6.0) se trouvant en principe dans WindowsSystem32
• Enregistrer le contrôle dans la base de registre à l'aide de Outils / Contrôles ActiveX du menu principal de MS Access. Le contrôle est alors visible si on clique sur l'icône ActiveX de la boite à outils d'un formulaire ouvert en mode création.
• Placer le contrôle sur le formulaire (bouton avec un téléphone)
• Dans le module du formulaire (ou un autre module) créer une référence sur : « Microsoft Comm Control » (Pour pouvoir utiliser les constantes liées à MSComm32)

ATTENTION :

Si vous ne disposez pas d'un produit développeur de Microsoft (Visual Basic, Visual Studio) vous ne pourrez pas faire le point [3]. En effet si vous recopiez un fichier MSComm32.ocx téléchargé sur le site de Microsoft ou d'ailleurs, la licence d'utilisation de celui n'est pas enregistrée dans votre base de registre et le point [3] provoque une erreur.

Solution :

Demandez à un ami qui dispose de VB et de Access de faire les opérations [2] + [3] + [4] sur son système et de vous transmettre le formulaire ainsi que MSComm32.ocx si vous ne le possédez pas. Vous pourrez alors, après avoir recopier MSComm32.ocx dans WindowsSystem32, piloter l'objet RSComm à partir de votre système. En effet il faut une licence pour placer l'objet mais pas pour l'utiliser. N'oubliez pas de faire les points [2] et [4] sur votre système.

Dans notre exemple l'objet de type MSComm placé sur le formulaire s'appelle RS232 et on pilote une balance Sartorius qui envoie des messages de 14 caractères.

Le principe est le suivant :

• Initialisation de l'objet RS232 (sur Open du formulaire par exemple) : InitBalance(). Vous devez disposer de la documentation du périphérique pour paramétrer correctement l'objet RS232
• Attendre que l'événement OnComm du contrôle RS232 se produise. Il se produit dès que RS232 a reçu le nombre de caractères paramétré en [1] avec la propriété : Rthreshold
• Traitement du message reçu : TraitReçu(PoidsBalance)
• Fermeture de la liaison : FermeBalance() (sur close du formulaire par exemple)
• Dans notre exemple on reçoit des messages de longueur fixe et le traitement est extrêmement simple. Si le nombre de caractères est variable (Lecture de codes barres par exemple) il faut régler la propriété Rthreshold sur 1 caractère et écrire un programme de traitement TraitReçu (Caractère) qui stocke les données reçues dans une variable Buffer (Utilisation d'une variable Static recommandée : Static Buffer as string, puis Buffer = Buffer & Caractère) et recherche dans Buffer un caractère de fin de message.

EXEMPLE de CODE (embarqué dans le formulaire)
 

Public Sub KillProcess(NameProcess As String)
    Const PROCESS_ALL_ACCESS = 0
    Const PROCESS_TERMINATE = (&H1)
    Const TH32CS_SNAPPROCESS As Long = 2&
    Dim uProcess As PROCESSENTRY32
    Dim RProcessFound As Long
    Dim hSnapshot As Long
    Dim SzExename As String
    Dim ExitCode As Long
    Dim MyProcess As Long
    Dim AppKill As Boolean
    Dim AppCount As Integer
    Dim i As Integer
    Dim WinDirEnv As String

    If NameProcess <> "" Then
        AppCount = 0
        uProcess.dwSize = Len(uProcess)
        hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
        RProcessFound = ProcessFirst(hSnapshot, uProcess)

        Do
            i = InStr(1, uProcess.szexeFile, Chr(0))
            SzExename = LCase$(Left$(uProcess.szexeFile, i - 1))
            WinDirEnv = Environ("Windir") + "\"
            WinDirEnv = LCase$(WinDirEnv)

            If Right$(SzExename, Len(NameProcess)) = LCase$(NameProcess) Then
                AppCount = AppCount + 1
                MyProcess = OpenProcess(PROCESS_TERMINATE, False, uProcess.th32ProcessID)
                AppKill = TerminateProcess(MyProcess, ExitCode)
                Call CloseHandle(MyProcess)
            End If
            RProcessFound = ProcessNext(hSnapshot, uProcess)
        Loop While RProcessFound
        Call CloseHandle(hSnapshot)
    End If
End Sub

Private Sub RS232_OnComm()
    ' OnComm est déclenché quand la balance a envoyé N caractères
    ' N correspond à la propriété [RThreshold] de l'objet MSComm
    Dim OK As Boolean, Statut As Long, Reçu As Variant
    Dim PoidsBalance As Long, MsgErr As String
    Statut = Me![RS232].CommEvent

    ' La balance a envoyé 14 caractères : [BB] [PPPPPPP] [ ] [C] [E] [CR+LF]
    ' [PPPPPPP] correspond au poids sous la forme 99999.9
    Reçu = Me![RS232].Input
    PoidsBalance = Mid(Reçu, 3, 7)    ' [PPPPPPP]
    If Statut = comEvReceive Then
        TraitReçu PoidsBalance
    Else
        'MSComm a détecté une erreur
        MsgErr = "ERREUR N° " & Statut & " : "

        Select Case Statut
        Case comEventBreak
            MsgErr = MsgErr & "Break signal received"
        Case comEventDCB
            MsgErr = MsgErr & "Unexpected error retrieving Device Control Block (DCB)"
        Case comEventFrame
            MsgErr = MsgErr & "Framing error"
        Case comEventOverrun
            MsgErr = MsgErr & "Port overrun"
        Case comEventRxOver
            MsgErr = MsgErr & "Receive buffer overflow"
        Case comEventRxParity
            MsgErr = MsgErr & "Parity error"
        Case comEventTxFull
            MsgErr = MsgErr & "Transmit buffer full"
        Case Else
            MsgErr = MsgErr & "???"
        End Select
        MsgBox MsgErr, vbExclamation
    End If

    ' On vide le buffer avant le prochain événement OnCom
    ' En effet, si passage de produits pendant l'affichage
    ' d'un message d'erreur, l'événement OnComm n'est pas
    ' exécuté puisqu'il est déjà en cours d'exécution et
    ' pendant ce temps là le buffer se remplit

    ' Remarque :
    ' il faut que le traitement de OnComm soit assez rapide
    ' pour se terminer avant un nouvel événement OnComm
    Me![RS232].InBufferCount = 0
End Sub

Private Sub TraitReçu(PoidsBalance As Long)
    ' Traitement d'une pesée
    Dim DB As Database, RS As Recordset
    Set DB = CurrentDb()
    Set RS = DB.OpenRecordset("SARTORIUS", dbOpenDynaset)
    RS.AddNew
    RS![Poids] = PoidsBalance
    RS.Update
End Sub

Private Sub FermeBalance()
    If Me![RS232].PortOpen = True Then
        Me![RS232].PortOpen = False
    End If
End Sub