'les Labels sont renommés ! c'est plus clair !
'exp Label1 = LbPds
Private KeyFinPesee As Boolean, PeseeEnCours As Boolean
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
KeyFinPesee = True
End Sub
Private Sub CommandButton1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = 27 Then KeyFinPesee = True
End Sub
Private Sub CommandButton1_Click() 'test pour éviter plusieurs clic dessus
If PeseeEnCours = False Then SaisiePesees
End Sub
Private Sub SaisiePesees()
'test pesées en cours et init KeyFinPesee
PeseeEnCours = True: KeyFinPesee = False
'No du Port, vide buffer, initialise, ouverture
MSComm1.CommPort = 5: MSComm1.InBufferCount = 0: MSComm1.Settings = "1200,E,7,1": MSComm1.PortOpen = True
'init vars pour boucle des saisies
Dim Msg$, Pds$, LenBuffer As Integer
LenBuffer = 17 'longueur des données dans le buffer
On Error GoTo Sortie: Err.Clear
'init les labels et le texte+couleur du bouton
LbMsg.Caption = "": LbPds.Caption = ""
CommandButton1.Caption = "Appuyez sur Print" & vbLf & "Terminé sur Echap"
CommandButton1.ForeColor = &H8000&
Do
MSComm1.InputLen = LenBuffer
'boucle tant que toutes les données ne sont pas là
Do While MSComm1.InBufferCount < LenBuffer
DoEvents: If KeyFinPesee = True Then Exit Do 'ceci quand tape sur esc
Loop
If KeyFinPesee = True Then Exit Do Else Beep
'Récupération des données, traitement de celles-ci, vide le buffer
Msg$ = MSComm1.Input: LbMsg.Caption = Msg$
Pds$ = Mid(Msg$, 8, 6): LbPds.Caption = Pds$
MSComm1.InBufferCount = 0
'Colle le Poids dans la Cellule Active et Active la suivante
ActiveCell.Value = Pds$: ActiveCell.Offset(1, 0).Activate
Loop
'fermeture du port et sortie
Sortie:
If Err Then
Msg$ = "Erreur " & Err.Source & " No " & Err.Number & vbLf & vbLf & Err.Description
MsgBox Msg$, vbCritical, "", Err.HelpFile, Err.HelpContext
End If
On Error GoTo 0: Err.Clear
MSComm1.InBufferCount = 0 'vide
MSComm1.PortOpen = False 'close
'reinit les labels et le texte+couleur du bouton
LbMsg.Caption = "": LbPds.Caption = ""
CommandButton1.Caption = "Pesées": CommandButton1.ForeColor = &H80000012
PeseeEnCours = False 'test fin pesées
End Sub