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
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.