Vba et rs232 envoyer des données via port série (exemple vers ecran lcd)

Soyez le premier à donner votre avis sur cette source.

Snippet vu 17 621 fois - Téléchargée 33 fois

Commenter

Contenu du snippet

Voila ayant tellement galéré pour trouver une source permettant de communiquer par port série avec du VBA je poste ici la solution que j'ai trouvé

Je cherchais un moyen d'envoyer des données depuis Acces vers un ecran LCD 4x20 or impossible...

Pour ceux qui ne comprendrais pas pourquoi je n'utilise pas MSCOM c'est simplement qu'il n'est pas fourni avec le VBA et qu'il est impossible de l'utiliser : message d'erreur : on n'a pas la licence =(

Pour contourner le probleme j'utilise turbo pascal 7.0 (le code n'est pas de moi)

Ensuite il suffit d'envoyer les variables dans la ligne de commande dans VBA :
Call Shell(Environ$("COMSPEC") & " /c c:\programme.exe variable1 variable2...", vbMinimizedNoFocus)

Voila.........

Source / Exemple : 


program com;

uses dos,crt;

const nbport = 0;       {**********************************************}
                        {* nbport = 0     pour    COM1                *}
                        {* nbport = 1     pour    COM2                *}
                        {**********************************************}

procedure rs_init;
{**********************************************************************}
{* Initialise le port RS232C : 8 bits de donn?es                      *}
{*                             2 bits Stop                            *}
{*                             Parit? Paire                           *}
{*                             Vitesse ? 2400 Bauds                   *}
{*  Cette procedure doit ?tre appel? une fois , avant de pouvoir      *}
{*  utiliser la liaison s?rie                                         *}
{*  Entrée: AH = 0x00               				      *}			
{*                        DX = Numéro de l'interface série	      *}
{*                                0x00 = COM1                  	      *} 
{*                                0x01 = COM2			      *}
{*                        AL = Paramètres de configuration	      *}
{*                                Bits 0-1: longueur du mot	      *}	
{*                                        10 = 7 bits		      *}
{*                                        11 = 8 bits		      *}
{*                                Bit 2: nombre de bits de stop	      *}
{*                                        0 = 1 bit de stop	      *}
{*                                        1 = 2 bits de stop	      *}
{*                                Bit 3-4: contrôle de parité	      *}
{*                                        00 = aucun		      *}
{*                                        01 = impair		      *}
{*                                        11 = pair		      *}
{*                                Bit 5-7: vitesse de transmission    *}
{*                                        000 = 110 bauds	      *}
{*                                        001 = 150 bauds	      *}
{*                                        010 = 300 bauds	      *}
{*                                        011 = 600 bauds	      *}
{*                                        100 = 1200 bauds	      *}
{*                                        101 = 2400 bauds	      *}
{*                                        110 = 4800 bauds	      *}
{*                                        111 = 9600 bauds	      *}
{*								      *}
{**********************************************************************}

var
   regs : registers;
begin
     regs.ah:=0;
     regs.dx:=nbport;
     regs.al:=227;

     intr($14,regs);
{     writeln('R?sultat initialisation ah=',regs.ah);}
end;

function rs_status:integer;
{*********************************************************************}
{* Cette fonction lit le statut du port s?rie                        *}
{*********************************************************************}
var
   regs : registers;
begin
     regs.ah:=3;
     regs.dx:=nbport;
     intr($14,regs);
     rs_status:=regs.ah;
end;

function rs_read:integer;
{***********************************************************************}
{* Lecture au vol de la RS232C , Si aucun caract?re n'a ?t? recu la    *}
{* function renvoie -1                                                 *}
{***********************************************************************}
var
   regs : registers;

begin
     if (rs_status and 1)=1 then
        begin
             regs.ah:=2;
             regs.dx:=nbport;
             intr($14,regs);
if (regs.ah and 128)=128 then begin
   writeln('Il y a eu erreur en lecture, AH=:',regs.ah);
   end else rs_read:=regs.al;
      end else begin
                      rs_read:=-1;
                  end;
end;

function rs_lecture : integer;
{********************************************************************}
{* Cette function attend q'un caract?re soit recu sur le port s?rie *}
{********************************************************************}
var
   aux : integer;
begin
     repeat
           aux:=rs_read;
     until aux<>-1;
     rs_lecture:=aux;
end;

procedure rs_write(data : byte);
{*******************************************************************}
{* Cette proc?dure permet d'emettre un caract?re sur le port s?rie *}
{*******************************************************************}
var
   regs : registers;

begin
     regs.ah:=1;
     regs.dx:=nbport;
     regs.al:=data;
     intr($14,regs);
     if (regs.ah and 128)=128 then writeln('Erreur transmition : ',regs.ah);
end;

procedure test_lecture;
{********************************************************************}
{* Cette procedure permet de tester la fiabilit? de la liaison      *}
{* PC - Robot , elle permet entre autre d'effectuer le r?glage de   *}
{* Vitesse de la RS232 du robot VECTOR                              *}
{********************************************************************}
var
   err,i,aux,cnt : integer;

begin
     clrscr;
     rs_init;
     aux:=-1;
     err:=-1;
     cnt:=-1;
     repeat
           rs_init;
           i:=rs_lecture;
           if i<>aux+1 then err:=err+1;
           aux:=i;
           if i=255 then aux:=-1;
           inc(cnt);
     until keypressed or (cnt=1000);
     writeln;
     writeln('Il y a eu ',err,' erreurs sur 1000 ');
end;

procedure test_ecriture;
{*******************************************************************}
{* Permet de tester l'?mission d'un caract?re vers le robot VECTOR *}
{*******************************************************************}
var i,aux,j : integer;
    carac : char;

begin
     clrscr;
     repeat
     repeat until keypressed;
     carac:=readkey;
     rs_init;
     rs_write(ord(carac));
     write(carac);
     until ((carac='Q') or (carac='q'));
end;

var
   x:integer;
   a:string[1];
   y,c:integer;
   texte : string;
begin
     rs_init;

     texte = paramstr(1);

     for x:=1 to 80 do
     begin
     a:=copy(texte,x,1);
     rs_write(ordre(a));
     end;
     end;
end.

Conclusion :


Si quelqu'un sais comment faire sans passer par le turbo pascal je suis preneur

A voir également

Ajouter un commentaire

Commentaire

Signaler
cs_neria
Messages postés
320
Date d'inscription
vendredi 21 février 2003
Statut
Membre
Dernière intervention
16 février 2009
 -
C'est plus du pascal que du vba ce code, enfin ca peut toujours servir !

@+ Neria
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_tombal)