Export access / Excel... aidez moi!!! svp

Export access / Excel... aidez moi!!! svp - VB/VBA/VBS - Programmation

Marsh Posté le 11-05-2005 à 11:20:42    

Salut,  
je réalise un projet de gestion sur Access, et afin d'effectuer une sauvegarde quotidienne de certains éléments de la base, je désire exporter ceux-ci dans un tableur excel dont la présentation est définie. Chaque élément de la base doit s'intégrer dans une case bien précise.  
Lorsque je clique sur le bouton auquel est affecté le code, le fichier excel s'ouvre bien mais rien ne "s'écrit" dans les cases. Si j'execute le code pas à pas, tout se passe bien, aucune erreur mais rien ne s'écrit dans le tableur! Voilà pourquoi j'ai besoin de votre aide pour déterminer ou est mon erreur dans le code.  
Merci d'avance aux volontaires.  
Mike  
*****  
 
Function ExcelExport1(Requête, Numéro)  
 
Dim db As Database  
Dim rs As Recordset  
Dim canal As Long  
Dim ligne As Integer  
Dim cellule, lc As Variant  
Dim fso, fn  
 
On Error Resume Next  
 
a = Shell("C:\PROGRAM FILES\MICROSOFT OFFICE\OFFICE10\EXCEL.EXE " + "c:\aero_easy" + "\COMPTA.XLS", 6)  
 
canal = DDEInitiate("Excel", "System" )  
données = DDERequest(canal, "TOPICS" )  
canal = DDEInitiate("Excel", "[COMPTA.XLS]COMPTA" )  
 
Set db = CurrentDb()  
Set rs = db.OpenRecordset(Requête)  
DDEPoke canal, "R3C6", Numéro  
 
ligne = 1  
rs.MoveFirst  
Do Until ligne = 10  
cellule = ""  
For i% = 0 To rs.Fields.Count - 4  
If IsNull(rs(i%)) Then  
cellule = cellule & Chr(9)  
Else  
If i% = 10 Then  
cellule = cellule & Chr(9) & rs(i%) & Chr(160) & Chr(9)  
Else  
cellule = cellule & rs(i%) & Chr(9)  
End If  
End If  
 
Next i%  
lc = "R" & ligne + 5 & "C2:R" & ligne + 5 & "C" & rs.Fields.Count + 1  
DDEPoke canal, lc, cellule  
rs.MoveNext  
ligne = ligne + 1  
Loop  
rs.Close  
 
DDEExecute canal, "[Save]"  
DDEExecute canal, "[Quit]"  
 
Source = "c:\aero_easy" + "\compta.xls"  
newname = "C:\aero_easy\compta" + Right("00" & CStr(Numéro), 7) + ".xls"  
Set fso = CreateObject("Scripting.FileSystemObject" )  
ok = fso.FolderExists("C:\aero_easy" )  
If Not ok Then  
fso.CreateFolder ("C:\aero_easy" )  
End If  
ok = fso.FileExists(newname)  
If ok Then  
msg = "Le fichier 'compta" + Right("00" & CStr(Numéro), 7) + ".xls' existe déjà sur 'C:\aero_easy', voulez-vous l'écraser?"  
Style = vbYesNo + vbQuestion + vbDefaultButton2 + vbApplicationModal  
Titre = "Confirmation"  
Beep  
ok1 = MsgBox(msg, Style, Titre)  
If ok1 = vbYes Then  
Kill newname  
fso.CopyFile Source, "C:\aero_easy\", True  
Name "C:\aero_easy\compta.xls" As newname  
End If  
Else  
fso.CopyFile Source, "C:\aero_easy", True  
Name "C:\aero_easy\compta.xls" As newname  
End If  
 
ExcelExport1 = True  
 
 
End Function  
 
****  
 
 
Merci aux courageux (euses)  

Reply

Marsh Posté le 11-05-2005 à 11:20:42   

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed