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