Envoyer des données à Excel depuis Access

Version imprimable

Bonjour
J'ai reçu 2 fichiers Excel qui ont beaucoup de Macros. Ces 2 fichiers interagissent avec un BD access comme suit: l'usager ouvre le 1er fichier Excel pour y copier ses données et clique sur un boutton pour les transferer à Access; puis ouvre le 2eme Excel pour continuer le travail. Le résultat attendu de ces interactions c'est un calcul d'optimisation: trouver un meilleur emplacement.
Je voudrais automatiser cela (j'ai toutes les villes du pays à traiter). Je considere les 2 Excel comme des boites noires et je commence le travail dpuis Access ou je stoque toutes les données que l'usager doit entrer dans le 1er Excel; j'appelle toutes les procedures d'Excel une après l'autre depuis Access.
J'ai plusieurs problèmes, je voudrais résoudre le 1er: quand j'envoie les données au premier fichier Excel, Excel s'ouvre et demande de sauveagarder à chaque fois.
Ma question, comment puis-je envoyer des données à Excel depuis Access sans ouvrir Excel et sauvegarder à chaque fois par dessus le fichier précedent?
Voici mon code pour trasferer depuis Access à Excel:

Code:

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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
'Sub WriteAccessTableToExcelBranchInfo(ByVal strTableName As String)
Sub WriteAccessTableToExcelBranchInfo()
Dim strTableName As String
strTableName = "tbl_BonEmplacement"
 
Dim strExcelTabName As String
strExcelTabName = "Micromarket Definition"
Dim strTransferFileName As String
strTransferFileName = "C:\Origin\TransferTool.xlsm"
  Dim wbexcel As Excel.workBook
        Dim wbExists As Boolean
        Dim objSht As Excel.workSheet
        Dim objRange As Excel.Range
 
        Set objExcel = CreateObject("excel.Application")
        objExcel.Visible = True
        On Error GoTo Openwb
        wbExists = False
'        Set wbexcel = objExcel.Workbooks.Add
        Set wbexcel = objExcel.Workbooks.Open(strTransferFileName, 0, False)
        Set objSht = wbexcel.Worksheets(strExcelTabName)
        objSht.Activate
        wbExists = True
        Worksheets(strExcelTabName).Range("C13:K3000").Clear
        Set objRange = objSht.Range("C13")
        objRange.Clear
'        Stop
'  I will put here tables
        Set rst = CurrentDb.OpenRecordset(strTableName)
        If (rst.RecordCount > 0) Then
        cnt = 1
        For Each fld In rst.Fields
        '            wks.Cells(1, cnt).value = fld.Name
            cnt = cnt + 1
        Next fld
        Call objRange.CopyFromRecordset(rst, 4000, 26)
        End If
 
    rst.Close
    Set rst = Nothing
    wbexcel.Application.DisplayAlerts = False
'    Stop
    wbexcel.Save
    wbexcel.Close
    wbexcel.Application.Quit
 
    Set objRange = Nothing
    Set objSht = Nothing
    Set wbexcel = Nothing
 
'.............................
' I here will deal with Exceptions
Openwb:
 
        On Error GoTo 0
        If Not wbExists Then
        objExcel.Workbooks.Add
        Set wbexcel = objExcel.ActiveWorkbook
        Set objSht = wbexcel.Worksheets(strExcelTabName)
 
        End If
 ' ...........................................
      Dim XL As Object
 
      Set XL = CreateObject("Excel.Application")
 
      XL.Workbooks.Open "C:\Origin\BranchNetTransferTool.xlsm"
 
      XL.Run "AppendOnly"
 
 '...........................................
End Sub

Bonjour,

Dans un des classeurs, as-tu une formule du type :

Code:

1
2
3
=MANINTENANt() 
'ou
=AUJOURDHUI()

?

:koi: pourquoi créés-tu une autre instance Excel ?

Ton code devrait plutôt être écrit ainsi car l'absence de classeur n'est pas une erreur; selon moi...

Code:

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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
 
Sub WriteAccessTableToExcelBranchInfo()
Dim strTableName                                       As String
 
Dim strExcelTabName                                    As String
Dim strTransferFileName                                As String
Dim objExcel                                           As excel.Application
Dim wbExcel                                            As excel.workBook
Dim objSht                                             As excel.workSheet
Dim objRange                                           As excel.Range
 
Dim wbExists                                           As Boolean
 
 
    On Error GoTo L_ErrWriteAccessTableToExcelBranchInfo
    'Table, Fichier et chemin à passer en paramètre
    strTableName = "tbl_BonEmplacement"
    strTransferFileName = "Z:\Trash\dvp\TransferTool.xlsx"
    strExcelTabName = "Micromarket Definition"
    wbExists = IIf(Dir(strTransferFileName, 0) <> "", True, False)
 
    Set objExcel = CreateObject("excel.Application")
    With objExcel
        .Visible = True
        .DisplayAlerts = False
        If wbExists Then
            Set wbExcel = .Workbooks.Open(strTransferFileName, 0, False)
        Else
            Set wbExcel = .Workbooks.Add
            With wbExcel
                .Worksheets(1).Name = strExcelTabName
                .SaveAs strTransferFileName
            End With
        End If
        With wbExcel
            Set objSht = .Worksheets(strExcelTabName)
 
            objSht.Activate
            'Adresse à passer en paramètre
            Set objRange = objSht.Range("C13")
            If wbExists Then
                'plage à passer en paramètre
                .Worksheets(strExcelTabName).Range("C13:K3000").Clear
                objRange.Clear
            End If
            'd'où vienne les 4000 ?
            Call CopyDataTable(strTableName, objRange, 4000)
            .Close True
        End With
 
        '.Workbooks.Open "C:\Origin\BranchNetTransferTool.xlsm"
        '.Run "AppendOnly"
 
        .Quit
    End With
 
 
    On Error GoTo 0
L_ExWriteAccessTableToExcelBranchInfo:
    Set objRange = Nothing
    Set objSht = Nothing
    Set wbExcel = Nothing
    Set objExcel = Nothing
    Exit Sub
 
L_ErrWriteAccessTableToExcelBranchInfo:
    MsgBox Err.Description, 48, Err.Source
    If Not objExcel Is Nothing Then
        objExcel.Quit
    End If
    Resume L_ExWriteAccessTableToExcelBranchInfo
 
End Sub
 
Private Sub CopyDataTable(ByVal TargetTable As String, ByRef Target As excel.Range, ByVal MaxRows As Long)
    Set rst = CurrentDb.OpenRecordset(TargetTable)
    If (rst.RecordCount > 0) Then
        cnt = 1
        For Each fld In rst.Fields
            cnt = cnt + 1
        Next fld
        Target.CopyFromRecordset rst, MaxRows, cnt
    End If
    rst.Close
    Set rst = Nothing
End Sub

Argy

15/01/2016, 20h49
abel.ludba

Salur Argy
Merci beaucoup pour la réponse: je l'ai testé pour un seul fichier cela marche.
Je vais la tester lundi sur l'enseble de données et je te laisserai savoir.

Pour repondre à ta question, je n'ai pas ces classeurs.
=MANINTENANt()
'ou
=AUJOURDHUI()

Merci encore
Bon WE
Abel

Salut Argy
J'ai essayé ton code et cela fonctionne tres bien. MERCI.
J'aurais une autre question:
Une fois 2 Tables sont reçues dans Excel ce dernier lance une procedure (AppendOnly) pour ajouter des données à la BD Access.
Cette action je dois l'initier depuis Access.
Je procède comme cela

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
           objSht.Activate
            'Adresse à passer en paramètre
            Set objRange = objSht.Range("C13")
            If wbExists Then
                'plage à passer en paramètre
                .Worksheets(strExcelTabName).Range("C13:K3000").Clear
                objRange.Clear
            End If
            'd'où vienne les 4000 ?
            Call CopyDataTable(strTableName, objRange, 4000)
            .Close True
        End With
 
        .Run "AppendOnly"
 
        .Quit
    End With

Mais, Excel arrête et demande de sauvgarder.
Qu'est que je dois changer?
Merci
Abel

18/01/2016, 16h17
argyronet

Que fait "AppendOnly" ?

Est-ce utile que l'instance Excel soit encore active pour cette macro ?

Argy
19/01/2016, 02h29
abel.ludba

Salut Argy
Le processus est comme suit: un fichier Excel (que j’appellerai outil de transfert) envoie les données à Access, et un autre fichier Excel (que j’appellerai outil d’optimisation) traite les données stockées dans Access.
Originalement, l’application est conçue pour optimiser une ville à la fois comme suit :
On ouvre l’outil de transfert, on y copie les données dans 2 Tabs (ce qui lance à peu près 100 macros). Puis, on clique sur un bouton qui lance la procédure « AppendOnly » qui transfert les données à Access. Donc, pour répondre à ta question, Excel doit rester active à ce moment-là.
La dernière étape, on ouvre l’outil d’optimisation qui lance des calculs d’optimisation sur les données dans Access
Merci encore pour ton aide
Abel
21/01/2016, 15h39
argyronet

Humm, en effet...
Bien moi, je ferais tout dans Access et enverrais le résultat final dans Excel.

Compte tenu du fait que ton classeur peut ne pas exister, ça signifie que tu n'en as pas besoin pour traiter l'info si ce n'est que tes 100 macros font très certainement quelque chose qu'Access saurait faire, non ?

Argy
24/01/2016, 01h46
abel.ludba

Salut Argy
Les gens qui ont créés ce logiciel l’ont fait de cette manière car ils utilisent l’optimisateur CBC lié à Excel. Faire tout dans Access serait logique.
Cependant, j’avais jusqu’à hier pour automatiser le travail et venir avec les résultats pour toutes les villes du pays : réécrire le code de plus de 100 macros (dans l'un des 2 fichiers) en une semaine, n’est possible pour moi. Voilà pourquoi j’ai décidé de procéder de cette façon : considérer les 2 fichiers Excel comme des boites noirs et mimer les gestes de l’utilisateur.
Cela a l’air de fonctionner.
Merci encore.
Abel
25/01/2016, 10h37
argyronet

Citation:

Donc, pour répondre à ta question, Excel doit rester active à ce moment-là.
La dernière étape, on ouvre l’outil d’optimisation qui lance des calculs d’optimisation sur les données dans Access

Donc, ce que tu peux faire, car il faut éviter de laisser une instance active commandé par un programme tiers, c'est de fermer Excel et mettre l'instance à Nothing une fois que le ObjAppXl est quitté.

Lorsque tu as déclenché cels, tu récupères le chemin complet de ton classeur et tu lances un Shell sous la forme :

Code:

dblRet = Shell("%Excel path%" "%Working Workbook FullPath%", 3)

A l'ouverture, l'objet Workbook lui-même de part son événement Open va appeler AppendOnly.
Il faudra cependant (ou pourquoi pas, à toi de voir) que AppendOnly vérifie que la feuille est la dernière version de contenu de données attendue, par exemple avec une date dans une cellule dédiée ou un N° unique passé en paramètre ou dans un fichier INI...
Cela te permet de t'assurer que l'envoi correspond bien à ce qui est attendu et par la suite (une fois la macro exécutée), tu rajoutes une valeur en dessous de cette cellule avec une mention du style : "Export Access effectué le : #date#" ; cela premettra de ne pas lancer deux fois de suite "AppendOnly" sur le même jeu de valeurs...

Qu'en penses-tu ?

Argy