Discussion :

[herr_jd]

Bonjour,
voici mon problème : dans une application Access, je pilote excel (qui reste caché) pour copier des données d'une table Access vers une feuille Excel puis pour mettre à jour des tableaux croisés dynamiques. Tout fonctionne correctement mais le traitement prend du temps : plusieurs minutes.
Par contre, si un utilisateur à la mauvaise idée de double-cliquer un fichier excel pendant le traitement alors ça crache car l'instance Excel est affichée et le workbook courant change !
Est-ce que quelqu'un sait comment 'réserver' l'instance Excel créée par automation pour le traitement Access ?
Merci.
jd

[JackOuYA]

Bonsoir,

la je vois pas comment utiliser une nouvelle instance d'excel, mais déjà tu peu éviter d'agir sur ActiveWorbook ou ActiveSheet et agir directement sur la bonne feuille, montre nous ton code..

[herr_jd]

Bonjour,

j'utilise effectivement des méthodes ActiveXXX.
Voici la fonction qui est utilisé pour la copie de données

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
 
' UpdateExcelFile
'   copy the data from a table into an existing excel sheet
'
Public Function UpdateExcelFile(ByRef objXL As Excel.Application, strFile As String, strSheet As String, strTable As String) As Boolean
On Error GoTo ErrorHandler
    Dim strPassword As String
    Dim objDB As ADODB.Connection
    Dim objRS As New ADODB.Recordset
    Dim objField As ADODB.Field
    Dim objSheet As Worksheet
    Dim objPT As PivotTable
    Dim strSQL As String
 
    'retrieve excel file password
    strPassword = getExcelFilePassword()
 
    'open the workbook
    Call objXL.Workbooks.Open(strFile, 0, False, , , strPassword, True)
    'open the worksheet 100-3
    objXL.Worksheets(strSheet).Activate
 
    'delete existing data and keep the column header (A1:AT1)
    objXL.ActiveSheet.Range("A2:AT65536").ClearContents
 
    'current DB connection
    Set objDB = CurrentProject.Connection
 
    'open the recordset
    strSQL = "SELECT * FROM " & strTable
    objRS.Open strSQL, objDB, adOpenForwardOnly, adLockReadOnly
    objRS.MoveFirst
 
    'copy the data if any
    If Not objRS.EOF And Not objRS.BOF Then
        objXL.ActiveSheet.Range("A2").CopyFromRecordset objRS
    End If
 
    'refresh all
    objXL.ActiveWorkbook.RefreshAll
 
    'ok
    UpdateExcelFile = True
 
ExitHandler:
    'save and close the file
    objXL.ActiveWorkbook.Close True, strFile
    'Clean memory
    If objRS.State = 1 Then objRS.Close
    Set objRS = Nothing
    Set objDB = Nothing
    Exit Function
 
ErrorHandler:
    UpdateExcelFile = False
    MsgBox Err.Description, vbCritical, "UpdateExcelFile exception handler"
    GoTo ExitHandler
End Function

et celle utilisée pour la mise à jour des PivotTables.
Il faut que ce soit le plus générique possible (je ne connais ni le nom des feuilles, ni le nom des tableaux croisés dynamiques). Je sais qu'il faut que je décoche automatiquement les dates "Mois evt" et "delivery month" qui sont dans le futur.

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
73
74
75
76
77
78
79
80
 
' UpdateAllPivotTables
'   update the PivotTable to automatically uncheck future dates
'
Public Function UpdateAllPivotTables(ByRef objXL As Excel.Application, strFile As String) As Boolean
On Error GoTo ErrorHandler
    Dim strPassword As String
    Dim objSheet As Worksheet
    Dim objPT As PivotTable
    Dim objPF As PivotField
    Dim objPI As PivotItem
    Dim dateEvent As Date
 
    'retrieve excel file password
    strPassword = getExcelFilePassword()
 
    'open the workbook
    Call objXL.Workbooks.Open(strFile, 0, False, , , strPassword, True)
 
    'iterate on Worksheets
    For Each objSheet In objXL.ActiveWorkbook.Worksheets
        'iterate on PivotTables
        For Each objPT In objSheet.PivotTables
            'optimized code - do not iterate on all PivotFields
            'if PivotField is the date "Mois evt" / "delivery month" then modify the selection
            '=> uncheck all dates in future month
            '"Mois evt"
            On Error Resume Next
            Set objPF = objPT.PivotFields("Mois evt")
            If Not (objPF Is Nothing) Then
                On Error GoTo ErrorHandler
                'iterate on PivotItems
                For Each objPI In objPF.PivotItems
                    If objPI.Value <> "(vide)" Then
                        'build a complete date dd-mmm-aa
                        dateEvent = "01-" & objPI.Value
                        'check if date is in future
                        If (dateEvent > Date) Then
                            objPI.Visible = False
                        End If
                    End If
                Next
                Set objPF = Nothing
            End If
            '"delivery month"
            On Error Resume Next
            Set objPF = objPT.PivotFields("delivery month")
            If Not (objPF Is Nothing) Then
                On Error GoTo ErrorHandler
                'iterate on PivotItems
                For Each objPI In objPF.PivotItems
                    If objPI.Value <> "(vide)" Then
                        'build a complete date dd-mmm-aa
                        dateEvent = "01-" & objPI.Value
                        'check if date is in future
                        If (dateEvent > Date) Then
                            objPI.Visible = False
                        End If
                    End If
                Next
                Set objPF = Nothing
            End If
            'Refresh the PivotTable
            objPT.RefreshTable
        Next
    Next
 
    'ok
    UpdateAllPivotTables = True
 
ExitHandler:
    'Save and close the file
    objXL.ActiveWorkbook.Close True, strFile
    Exit Function
 
ErrorHandler:
    UpdateAllPivotTables = False
    MsgBox Err.Description, vbCritical, "UpdateAllPivotTable exception handler"
    GoTo ExitHandler
End Function

Tu es en train de me dire que le moyen est de modifier le code pour que Excel continue à réaliser le traitement même si il y a un autre classeur ouvert et que l'utilisateur travaille dedans ?

Merci.
jd

[fring]

Bonjour,

Pour commencer évite les "ActiveSheet", "ActiveWorbook" et ActiveMachin en tous genres.

En début de code tu initialises quelques variables avec le classeur et la ou les feuilles concernées

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Dim Wbk As Workbook, Wsh As Worksheet
 
Set Wbk = ThisWorkbook
Set Wsh = Wbk.Sheets("MaFeuille")

Ensuite dans ton code, tu remplaces les ActiveWorkbook par Wbk et les ActiveSheet par Wsh.

Essaye comme ça pour voir si ça coince encore.
.