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 : Sélectionner tout - Visualiser dans une fenêtre à part
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