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
1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | ... | ... | ... |
B | B | B | S | D7 | D6 | D5 | D4 | D3 | D2 | D1 | DP | D0 | B | U | ... | CR | LF |
B | Blanc | Caractère blanc (espace) |
S | Sign | Signe (+,-,espace) |
DP | Decimal Point | Point décimal |
D0...D7 | Digits | Chiffres |
U | Unit | Unité |
CR | Carriage Return | Retour Chariot |
LF | Line Feed | Saut de tr |
MSComm1.InputLen = 20
'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
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 !?
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
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
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
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
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.
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
' 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
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...
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
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
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