Balance RS232 [RESOLU]

P

pitufo2804

XLDnaute Junior
Bonjour,
Apres quelques recherches sur google je ne trouve pas de solutions concrètes...
J'essaie de développer une "appli" permettant de récupérer des valeurs issue d'une balance connectée en RS232 au PC.
Ma balance est configurée de la sorte :
- 1200bauds
- 7 bits de données
- 1 bit de parité (paire)
- 1 bit de stop
J'ai ces quelques lignes de code afin de récupérer la valeur :
Code: 
Private Sub CommandButton1_Click()

With MSComm1
    .InBufferCount = 0
    .CommPort = 1
    .Handshaking = comNone
    .Settings = "1200,o,7,1"
    .InputLen = 3
    .PortOpen = True
End With

Do While MSComm1.Input <> "   +"
Loop

MSComm1.InputLen = 5
    Label1.Caption = MSComm1.Input
    ActiveCell.Value = CSng(Label1.Caption)
    ActiveCell.Offset(1, 0).Select
    
MSComm1.PortOpen = False

End Sub

Mais j'ai une erreur à la ligne " Do While MSComm1.Input <> " +" "
qui me dit :
" Erreur d'éxécution '8020':
Error reading comm device."
J'ai quand même effectué des test avec l'hyper terminal et la com fonctionne sans soucis.
Enfin, sur la doc de la balance, la trame est comme ça :
123456789101112131415.........
BBBSD7D6D5D4D3D2D1DPD0BU...CRLF

BBlancCaractère blanc (espace)
SSignSigne (+,-,espace)
DPDecimal PointPoint décimal
D0...D7DigitsChiffres
UUnitUnité
CRCarriage ReturnRetour Chariot
LFLine FeedSaut de tr

[entete]Sigle[/entete]
[entete]Signification[/entete]
[entete]Descriptif[/entete]
 
Dernière édition:
Trier par date Trier par votes
Roland_M

Roland_M

XLDnaute Barbatruc
Re : Balance RS232

re

Code: 
'ICI POUR VOIR LA COMPOSITION DU CHAMP COMPLET !
'-----------------------------------------------
'A LA PLACE DE CI-DESSOUS ...
'Boucle dans le vide tant que le caractère lu n'est pas un signe plus (+)
'Do
'DoEvents
'Loop While MSComm1.Input <> " "
'ESSAI AVEC CECI
'---------------
Dim Reponse As Variant, Msg$
On Error Resume Next: Err.Clear
Do: If Err Then Exit Do
MSComm1.InputLen = 1
Msg$ = Msg$ & MSComm1.Input
Reponse = MsgBox(Msg$, vbOKCancel, "Annuler pour quitter")
If Reponse <> vbOK Then Exit Do
Loop

car je pense qu'il faut boucler pour saisir tout le champ envoyé caractère par caractère
et traiter la chaine après !?
 
Dernière édition:
Vote positif 0 Vote négatif
P

pitufo2804

XLDnaute Junior
Re : Balance RS232

Roland_M à dit:
re

Code: 
'ICI POUR VOIR LA COMPOSITION DU CHAMP COMPLET !
'-----------------------------------------------
'A LA PLACE DE CI-DESSOUS ...
'Boucle dans le vide tant que le caractère lu n'est pas un signe plus (+)
'Do
'DoEvents
'Loop While MSComm1.Input <> " "
'ESSAI AVEC CECI
'---------------
Dim Reponse As Variant, Msg$
On Error Resume Next: Err.Clear
Do: If Err Then Exit Do
MSComm1.InputLen = 1
Msg$ = Msg$ & MSComm1.Input
Reponse = MsgBox(Msg$, vbOKCancel, "Annuler pour quitter")
If Reponse <> vbOK Then Exit Do
Loop

car je pense qu'il faut boucler pour saisir tout le champ envoyé caractère par caractère
et traiter la chaine après !?
Cliquez pour agrandir...

YYEEEEEESSSSSSSSS !!!!!!!!!!!!!!
Merci beaucoup !!!!!
Je l'adapte pour avoir juste le poids et je poste le code final.
 
Vote positif 0 Vote négatif
P

pitufo2804

XLDnaute Junior
Re : Balance RS232

Voilà le code final et fonctionnel :
Code: 
Private Sub CommandButton1_Click()

'Vider le buffer
MSComm1.InBufferCount = 0
'Numéro port série
MSComm1.CommPort = 1
'Vitesse, parité, nb bits
MSComm1.Settings = "1200,e,7,1"

'ouvre le port
MSComm1.PortOpen = True

'Lecture de la trame
Dim Reponse As Variant, Msg$
On Error Resume Next: Err.Clear
Do: If Err Then Exit Do
MSComm1.InputLen = 15
Msg$ = Msg$ & MSComm1.Input
Reponse = MsgBox("Appuyer sur le bouton PRINT de la balance et cliquer sur OK" & vbCrLf & Msg$, vbOKCancel, "Annuler pour quitter")
If Reponse <> vbOK Then Exit Do
Loop

'Traitement de la pesée
If (Msg$ <> "") Then
    'Affichage dans l'userform
    Label1.Caption = Msg$
    'Lecture à partir du 8ème bit
    Msg$ = Mid(Msg$, 8)
    'Lecture de 6 bits
    Msg$ = Left(Msg$, 6)
    'Ecriture du poids dans la cellule active
    ActiveCell.Value = Msg$
End If
    
'ferme le port
MSComm1.PortOpen = False

End Sub

Maintenant à améliorer pour faire une série de pesées qui s'affichent automatiquement dans les cellules....
 
Dernière édition:
Vote positif 0 Vote négatif
Roland_M

Roland_M

XLDnaute Barbatruc
Re : Balance RS232 [RESOLU]

re

tout d'abord il s'agit d'octet ou byte (8bit) et pas de bit(0 ou 1)

'Traitement de la pesée
If (Msg$ <> "") Then
'Affichage dans l'userform
Label1.Caption = Msg$
'Lecture à partir du 8ème bit
Msg$ = Mid(Msg$, 8)
'Lecture de 6 bits
Msg$ = Left(Msg$, 6)
'Ecriture du poids dans la cellule active
ActiveCell.Value = Msg$
End If

comme ceci c'est suffisant
If Msg$ <> "" Then
Label1.Caption = Msg$ 'Affichage dans l'userform
'colle le poids dans la cellule active (8'position sur 6 caractères)
ActiveCell.Value = Mid(Msg$, 8, 6)
End If
 
Dernière édition:
Vote positif 0 Vote négatif
P

pitufo2804

XLDnaute Junior
Re : Balance RS232 [RESOLU]

Et voilà avec une série :
Code: 
Private Sub CommandButton1_Click()

'Vider le buffer
MSComm1.InBufferCount = 0
'Numéro port série
MSComm1.CommPort = 1
'Vitesse, parité, nb bits
MSComm1.Settings = "1200,e,7,1"

'ouvre le port
MSComm1.PortOpen = True

'Lecture de la trame
Dim Reponse As Variant, Msg$
On Error Resume Next: Err.Clear
Do: If Err Then Exit Do
MSComm1.InputLen = 17
Msg$ = ""
Msg$ = Msg$ & MSComm1.Input

'Temps d'attente
Sleep (200)

'Lecture à partir du 8ème bit
Msg$ = Mid(Msg$, 8)
'Lecture de 6 bits
Msg$ = Left(Msg$, 6)

'Ecriture du poids dans la cellule active
ActiveCell.Value = Msg$
'Message box
Reponse = MsgBox("Appuyer sur le bouton PRINT de la balance et cliquer sur OK" & vbCrLf & Msg$, vbOKCancel, "Annuler pour quitter")

'Sortir de la boucle
If Reponse <> vbOK Then Exit Do
Loop

'Traitement de la pesée
If (Msg$ <> "") Then
    'Affichage dans l'userform
    Label1.Caption = Msg$
End If

'Déplacement cellule
ActiveCell.Offset(1, 0).Activate

'ferme le port
MSComm1.PortOpen = False

End Sub
Avec ceci dans un module séparé pour la fonction Sleep() :
Code: 
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Et en PJ le classeur complet...
 

Pièces jointes

  • Classeur2.xls
    58 KB · Affichages: 71
  • Classeur2.xls
    58 KB · Affichages: 66
  • Classeur2.xls
    58 KB · Affichages: 71
Dernière édition:
Vote positif 0 Vote négatif
Roland_M

Roland_M

XLDnaute Barbatruc
Re : Balance RS232 [RESOLU]

re

'ceci étant déjà effectué
MSComm1.InputLen = 17: Msg$ = MSComm1.Input: Msg$ = Mid(Msg$, 8, 6)
'comment se fait-il qu'il faille appuyer après sur le Print balance ?
Reponse = MsgBox("Appuyer sur le bouton PRINT de la balance et cliquer sur OK" & vbCrLf & Msg$, vbOKCancel, "Annuler pour quitter")

pourrais tu expliquer en détails le déroulement, merci.
 
Vote positif 0 Vote négatif
Roland_M

Roland_M

XLDnaute Barbatruc
Re : Balance RS232 [RESOLU]

re

car personnellement j'aurai plutôt penser faire comme ceci:
sans Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
et si tu pouvais me dire si cela fonctionne ce serait sympa ! merci !

Code: 
Private Sub CommandButton1_Click()
MSComm1.InBufferCount = 0 'vide buffer
MSComm1.CommPort = 1 'No port série
MSComm1.Settings = "1200,e,7,1" 'vitesse, parité, nb bits
MSComm1.PortOpen = True 'ouvre le port

'Lecture de la trame
Dim Reponse As Variant, Msg$, Pds$
On Error Resume Next: Err.Clear
Do
 MSComm1.InputLen = 17 ' <<<<<<<<<< ceci ICI ??????
 Reponse = MsgBox("Appuyer sur le bouton PRINT de la balance et cliquer sur OK" & vbCrLf & Msg$, vbOKCancel, "Annuler pour quitter")
 If Reponse <> vbOK Then Exit Do
' MSComm1.InputLen = 17 ' <<<<<<<<<< OU LA ??????
 Msg$ = MSComm1.Input: If Err Then Exit Do
T! = Timer: While Abs(Timer - T) < 0.2: DoEvents: Wend 'delay
 Pds$ = Mid(Msg$, 8, 6)
 ActiveCell.Value = Pds$ 'colle le poids dans la cellule active
 ActiveCell.Offset(1, 0).Activate 'cellule suivante
Loop
'Affichage dans l'userform et ferme le port
If Msg$ > "" Then Label1.Caption = Pds$
MSComm1.PortOpen = False
End Sub

EDIT: j'avais oublié DoEvents dans le delay
 
Dernière édition:
Vote positif 0 Vote négatif
P

pitufo2804

XLDnaute Junior
Re : Balance RS232 [RESOLU]

Roland_M à dit:
re

'ceci étant déjà effectué
MSComm1.InputLen = 17: Msg$ = MSComm1.Input: Msg$ = Mid(Msg$, 8, 6)
'comment se fait-il qu'il faille appuyer après sur le Print balance ?
Reponse = MsgBox("Appuyer sur le bouton PRINT de la balance et cliquer sur OK" & vbCrLf & Msg$, vbOKCancel, "Annuler pour quitter")

pourrais tu expliquer en détails le déroulement, merci.
Cliquez pour agrandir...

L'appli se déroule de cette façon :
- Cliquer sur le bouton pour afficher l'userform
- Cliquer sur le bouton de l'userform pour afficher la msgbox et récupérer le poids
- Appuyer sur le bouton print de la balance pour envoyer le poids
- Cliquer sur le bouton ok de la msgbox pour enregistrer le poids dans les cellules

Roland_M à dit:
re

car personnellement j'aurai plutôt penser faire comme ceci:
sans Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
et si tu pouvais me dire si cela fonctionne ce serait sympa ! merci !

Code: 
Private Sub CommandButton1_Click()
MSComm1.InBufferCount = 0 'vide buffer
MSComm1.CommPort = 1 'No port série
MSComm1.Settings = "1200,e,7,1" 'vitesse, parité, nb bits
MSComm1.PortOpen = True 'ouvre le port

'Lecture de la trame
Dim Reponse As Variant, Msg$, Pds$
On Error Resume Next: Err.Clear
Do
 MSComm1.InputLen = 17 ' <<<<<<<<<< ceci ICI ??????
 Reponse = MsgBox("Appuyer sur le bouton PRINT de la balance et cliquer sur OK" & vbCrLf & Msg$, vbOKCancel, "Annuler pour quitter")
 If Reponse <> vbOK Then Exit Do
' MSComm1.InputLen = 17 ' <<<<<<<<<< OU LA ??????
 Msg$ = MSComm1.Input: If Err Then Exit Do
T! = Timer: While Abs(Timer - T) < 0.2: DoEvents: Wend 'delay
 Pds$ = Mid(Msg$, 8, 6)
 ActiveCell.Value = Pds$ 'colle le poids dans la cellule active
 ActiveCell.Offset(1, 0).Activate 'cellule suivante
Loop
'Affichage dans l'userform et ferme le port
If Msg$ > "" Then Label1.Caption = Pds$
MSComm1.PortOpen = False
End Sub

EDIT: j'avais oublié DoEvents dans le delay
Cliquez pour agrandir...

Ce code marche impeccable aussi que l'on mette MSComm1.InputLen = 17 avant ou après la msgbox.

EDIT: Le seul défaut de tous les codes trouvés est qu'il faut faire anuler à chaque changement de poids sinon il y a une valeur vide entre chaque cellule...
 
Dernière édition:
Vote positif 0 Vote négatif
Roland_M

Roland_M

XLDnaute Barbatruc
Re : Balance RS232 [RESOLU]

re, merci pour l'info !

mais pour la saisie en auto ce n'est pas comme cela que ça fonctionne !
comme je le disais en début de discussion, j'ai travaillé en production verrerie flaconnage parfum
et quand je devais peser par exp 12 flacons vides puis pleins pour avoir les capacités afin de définir un poids de travaille, je lançai la procédure et je restai à la balance et pesai tout à la file sans aller à l'ordi !
sous QuickBasic j’avais la fonction INKEY$ qui me permettait de boucler en continue
pour saisir une touche au clavier ou de tester un événement quelconque.
ce qui permettait même d'annuler une pesée et de remonter à la précédente ou tout simplement d'abandonner etc...
et pour ce qui de la saisie des pesées avec Open Com j’avais quelque chose du genre pour mes essais
While Not EOF(1)
Mux$ = Input$(LOC(1), 1) ‘LOC(1) donne le nombre de caractère dans la file
Filtre Mux$ ' appel fonction pour éliminer sauts de ligne et retour arrière
Print Mux$; ‘ aff résultat
Wend

mais ici, pour le faire il me faudrait avoir le matériel pour réaliser cette procédure sous excel qui ne devrait pas être si compliqué que cela.
j'ai fais des recherches et il y aurait l'événement MSComm1_OnComm MSComm1.CommEvent
qui permettrait cela ! avec ce test > comEvEOF ' On a reçu le caractère EOF

exemple trouvé sur le net (vb6) mais je pense possible d'adapter

Code: 
' Cette procedure sert à traiter l’information reçue dans le tampon
Dim Tampon$
Do: DoEvents
    Tampon$ = Tampon$ & MSComm1.Input
Loop Until InStr(Tampon$, "OK" & vbCrLf)

Private Sub MSComm1_OnComm()
Select Case MSComm1.CommEvent

    'liste des erreurs possibles
    Case comEventBreak      ' On a reçu un signal d’interruption (Break)
    Case comEventCDTO       ' Timeout de la porteuse
    Case comEventCTSTO      ' Timeout du signal CTS (Clear To Send)
    Case comEventDSRTO      ' Timeout du signal de réception
    Case comEventFrame      ' Erreur de trame
    Case comEventOverrun    ' Des données ont été perdues
    Case comEventRxOver     ' Tampon de réception saturé
    Case comEventRxParity   ' Erreur de parité
    Case comEventTxFull     ' Tampon d’envoi saturé
    Case comEventDCB        ' Erreur de réception DCB (jamais vu)

    ' liste des événements possibles qui sont, eux, normaux
    Case comEvCD            ' Changement dans la broche CD (porteuse)
    Case comEvCTS           ' Changement dans broche CTS
    Case comEvDSR           ' Changement dans broche DSR (réception)
    Case comEvRing          ' Changement dans broche RING (sonnerie)

    Case comEvReceive       ' Si on reçoit des données
                              tampon=MSComm1.Input
                              Call Traitement(tampon) ' Routine de traitement

    Case comEvSend          ' Il y a des caractères à envoyer
    Case comEvEOF           ' On a reçu le caractère EOF

End Select
End Sub
 
Vote positif 0 Vote négatif
Roland_M

Roland_M

XLDnaute Barbatruc
Re : Balance RS232 [RESOLU]

re

dans ton dernier post tu dis:
Ce code marche impeccable aussi que l'on mette MSComm1.InputLen = 17 avant ou après la msgbox.

EDIT: Le seul défaut de tous les codes trouvés est qu'il faut faire anuler à chaque changement de poids sinon il y a une valeur vide entre chaque cellule...
Cliquez pour agrandir...


il faut rajouter ceci: MSComm1.InBufferCount = 0 'vider le buffer
SOIT:
Code: 
Private Sub OldCommandButton1_Click()
MSComm1.InBufferCount = 0 'vide buffer
MSComm1.CommPort = 1 'No port série
MSComm1.Settings = "1200,e,7,1" 'vitesse, parité, nb bits
MSComm1.PortOpen = True 'ouvre le port

'Lecture de la trame
Dim Reponse As Variant, Msg$, Pds$
On Error Resume Next: Err.Clear
Do
 Reponse = MsgBox("Appuyer sur le bouton PRINT de la balance et cliquer sur OK" & vbCrLf & Msg$, vbOKCancel, "Annuler pour quitter")
 If Reponse <> vbOK Then Exit Do
 MSComm1.InputLen = 17: Msg$ = MSComm1.Input: If Err Then Exit Do
 T! = Timer: While Abs(Timer - T) < 0.2: DoEvents: Wend 'delay
 Pds$ = Mid(Msg$, 8, 6): Label1.Caption = Pds$
 ActiveCell.Value = Pds$ 'colle le poids dans la cellule active
 ActiveCell.Offset(1, 0).Activate 'cellule suivante
 MSComm1.InBufferCount = 0 'vide buffer
Loop
MSComm1.PortOpen = False
End Sub
 
Vote positif 0 Vote négatif
P

pitufo2804

XLDnaute Junior
Re : Balance RS232 [RESOLU]

Roland_M à dit:
re

dans ton dernier post tu dis:



il faut rajouter ceci: MSComm1.InBufferCount = 0 'vider le buffer
SOIT:
Code: 
Private Sub OldCommandButton1_Click()
MSComm1.InBufferCount = 0 'vide buffer
MSComm1.CommPort = 1 'No port série
MSComm1.Settings = "1200,e,7,1" 'vitesse, parité, nb bits
MSComm1.PortOpen = True 'ouvre le port

'Lecture de la trame
Dim Reponse As Variant, Msg$, Pds$
On Error Resume Next: Err.Clear
Do
 Reponse = MsgBox("Appuyer sur le bouton PRINT de la balance et cliquer sur OK" & vbCrLf & Msg$, vbOKCancel, "Annuler pour quitter")
 If Reponse <> vbOK Then Exit Do
 MSComm1.InputLen = 17: Msg$ = MSComm1.Input: If Err Then Exit Do
 T! = Timer: While Abs(Timer - T) < 0.2: DoEvents: Wend 'delay
 Pds$ = Mid(Msg$, 8, 6): Label1.Caption = Pds$
 ActiveCell.Value = Pds$ 'colle le poids dans la cellule active
 ActiveCell.Offset(1, 0).Activate 'cellule suivante
 MSComm1.InBufferCount = 0 'vide buffer
Loop
MSComm1.PortOpen = False
End Sub
Cliquez pour agrandir...

Merci beaucoup ! t'es génial !!!
 
Vote positif 0 Vote négatif
P

pitufo2804

XLDnaute Junior
Re : Balance RS232 [RESOLU]

Rectification au niveau du temps d'attente...
Mais sinon ça marche impeccable
Code: 
Private Sub CommandButton1_Click()

'Vide le buffer
MSComm1.InBufferCount = 0
'No port série
MSComm1.CommPort = 1
'Vitesse, parité, nb bits
MSComm1.Settings = "1200,e,7,1"
'Ouvre le port
MSComm1.PortOpen = True

'Lecture de la trame
Dim Reponse As Variant, Msg$, Pds$
On Error Resume Next: Err.Clear
Do
    'Messagebox
    Reponse = MsgBox("Appuyer sur le bouton PRINT de la balance et cliquer sur OK" & vbCrLf & Msg$, vbOKCancel, "Annuler pour quitter")
    If Reponse <> vbOK Then Exit Do
    'Temps d'attente
    T! = Timer: While Abs(Timer - T) < 0.2: DoEvents: Wend
    'Récupération du poids
    MSComm1.InputLen = 17: Msg$ = MSComm1.Input: If Err Then Exit Do
    'Traitement du poids
    Pds$ = Mid(Msg$, 8, 6): Label1.Caption = Pds$
    'Colle le poids dans la cellule active
    ActiveCell.Value = Pds$
    'Active la cellule suivante
    ActiveCell.Offset(1, 0).Activate
    'Vide le buffer
    MSComm1.InBufferCount = 0
Loop

'Fermeture du port
MSComm1.PortOpen = False

End Sub
 

Pièces jointes

  • Classeur2.xls
    43.5 KB · Affichages: 54
  • Classeur2.xls
    43.5 KB · Affichages: 54
  • Classeur2.xls
    43.5 KB · Affichages: 57
Vote positif 0 Vote négatif

Discussions similaires

A
  • Question
Acquisition , valeur dans le buffer
Réponses
8
Affichages
979
amineham1
A
M
  • Question
Recupérer signal RS232 dans Excel via VBA. Communication etablie.
Réponses
5
Affichages
20 K
Dranreb
Dranreb
D
  • Question
Liaison RS232 sur excel
Réponses
5
Affichages
4 K
Dohko10270
D
D
  • Question
Impossible de sortir de la boucle DO sans CTRL+PAUSE
Réponses
6
Affichages
2 K
Dohko10270
D
J
  • Question
Erreur d'execution 50290
Réponses
2
Affichages
2 K
jeanlaracine
J

Membres actuellement en ligne

16 membres et 150 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 194
Messages
2 086 069
Membres
103 110
dernier inscrit
Privé