1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38
| Private Sub CommandButton1_Click()
'Application.ScreenUpdating = False
Dim origine As Range
Call Pupitre
Set origine = ActiveCell
line1: 'maquage de ligne pour GOTO fin de pocedure
MSComm1.InBufferCount = 0 'Vider le buffer
MSComm1.CommPort = 14 ' choisir un port série
MSComm1.Settings = "1200,o,7,2" '1200 bauds, impair, 7 bits de données, 2 bits d'arrêt
MSComm1.InputLen = 1 ' indique au contrôle qu'il doit lire 1 seul caractère ce caractère sert à
MSComm1.PortOpen = True 'ouvre le port
'UserForm1.Label2.Visible = True 'affiche un message
UserForm1.Repaint
Do While MSComm1.Input <> " " 'Boucle tant que le 1er caractère n'est pas un signe ( )
Label1.Caption = "Rien reçu !"
DoEvents ' Donne le contrôle à d'autres processus.
Loop
Dim PauseTime, Start, Finish, TotalTime
PauseTime = 3.2 ' Définit la durée.
Start = Timer ' Définit l'heure de début.
Do While Timer < Start + PauseTime
DoEvents ' Donne le contrôle à d'autres processus.
Loop
ActiveSheet.Unprotect Password:=""
origine.Select
MSComm1.InputLen = 0 'lecture sur le port des X 1ers caractères et stockage dans la boite de dialogue et dans la feuille active
ActiveCell.Value = MSComm1.Input 'Chargement de la valeur MSComm1.Input dans la cellule active
ActiveCell.Offset(0, 10).Select
ActiveCell.Value = Now
ActiveCell.Offset(1, -10).Select
MSComm1.PortOpen = False 'ferme le port
Set origine = ActiveCell
ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True
GoTo line1
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub |
Partager