Discussion :

[Trinou]

Bonjour à tous,

Je suis une débutante en traitement Excel->BO via macro et je suis confrontée à un probleme surement connu :
Je lance une macro d'export depuis BO (c'est un traitement automatique depuis un serveur) et lorsque mon traitement est terminé Excel ne se ferme pas et garde mon fichier du coup j'ai le message suivant :
"Fichier est déjà ouvert par 'serveur' notifié blablabla"

Je suppose qu'il y a un flux que je ne ferme pas mais je n'arrive pas à voir lequel ... (en plus le code de base n'est pas de moi)

Pourriez vous m'aider ?
Merci d'avance

Un petit peu de code pour mieux comprendre :

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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
 
Const path = "truc"
Const pathBackup = "truc\backup\ "
Const fileName = "fichier.xls"
 
 
Sub runexport()
    On Error GoTo ErrorHandler  ' Enable error-handling routine.
 
 'Make a backup before doing anything... just in case
 Dim fs As Object
 Set fs = CreateObject("Scripting.FileSystemObject")
 fs.CopyFile path & fileName, path & fileName
 'if we are on monday, make a weekly backupme & ".backup" 'This file was an .xls file
 
 If (WeekDay(Date) = 3) Or (WeekDay(Date) = 4) Or (WeekDay(Date) = 6) Then 'mardi ou mercredi ou vendredi
    fs.CopyFile path & fileName, pathBackup & fileName & "_wk" & DatePart("ww", Date) & " _d" & WeekDay(Date) & ".backup"   ' this will be "lsf_data_Wk<WeekNumber>_D<vbDayNumber>.xls.backup"
 End If
 
 
 Set fs = Nothing
 
 Dim rep As Report
 Dim msgtext As String
 Dim ExcelApp As Object
 Dim ErrorNumber
 
 Dim i As Integer
 
 
 'this bypass the issue concerning the formatting problem with dates
 'Enter the range containing date information to force as text
 Dim dateRange As String
 dateRange = "C:I"
 
 repname = ActiveDocument.Name
 
 
 Set rep = ActiveDocument.Reports.Item(ActiveDocument.Reports.Count)
 msgtext = rep.Name
 
 Set myxlapp = CreateObject("Excel.Application")
 
 
 Set MyxlBook = myxlapp.Workbooks.Open(path & fileName)
 Set Myxlsheet = MyxlBook.worksheets(1)
 
 myxlapp.Application.Visible = False
 myxlapp.Parent.Windows(1).Visible = True
 
'INHIBITION DES MESSAGES
myxlapp.Application.DisplayAlerts = False
 rep.Activate
 'Kill MyxlBook ' Attempt to delete open file.
 'MsgBox (Err.Number)
 
'copy all
 Set mControls = Application.CmdBars.Item(2).Controls
 Set mPopup1 = mControls.Item(2)
 Set mControls = mPopup1.CmdBar.Controls
 mControls.Item(20).Execute
 
'Excel sheet
 myxlapp.Application.worksheets(1).Activate
 
 
 'unprotect sheet
 myxlapp.Run "UnprotectSheet"
 
 
 'dumb but necessary: cannot show all data if all the data is already shown...
 myxlapp.Application.Selection.AutoFilter Field:=10, Criteria1:="0"
 'pareil pour sheet 2
 
 myxlapp.Application.worksheets(1).ShowAllData
 
 
 ''''''''''''''''''''''''''''''''''''''''''''''''''
 ''''''''''''''''''''''''''''''''''''''''''''''''''
 ''''''''''''''''''''''''''''''''''''''''''''''''''
 
 myxlapp.Application.worksheets(1).Name = rep.Name
 
 'format to text, to bypass date formatting issues
 myxlapp.Application.worksheets(1).Columns(dateRange).NumberFormat = "@"
 myxlapp.Application.worksheets(1).Columns(dateRange).Locked = False
 
 myxlapp.Application.worksheets(1).Range("A1").Select
 
 myxlapp.Application.worksheets(1).PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False
 
 myxlapp.Run "defineTargetRange"    'define target range containing data and delete blank lines
 myxlapp.Run "createSheetDemande"
 myxlapp.Run "DefineDemandFormulas"
 
 myxlapp.Application.worksheets(1).Range("Target_Area").Select
 
 'autofilter
  myxlapp.Application.Selection.AutoFilter Field:=10, Criteria1:="0"
  myxlapp.Application.Selection.AutoFilter Field:=12, Criteria1:="0"
 
  myxlapp.Application.worksheets(2).Activate
  myxlapp.Application.worksheets(2).Range("A:P").Select
 
 'autofilter
  myxlapp.Application.Selection.AutoFilter Field:=10, Criteria1:="0"
  myxlapp.Application.Selection.AutoFilter Field:=12, Criteria1:="0"
 
 
 
 'the line below make Excel to freeze
 'myxlApp.Run "formatSheet"          'create tabs, filter on conforms only...
 
 
 ''''''''''''''''''''''''''''''''''''''''''''''''''
 ''''''''''''''''''''''''''''''''''''''''''''''''''
 ''''''''''''''''''''''''''''''''''''''''''''''''''
 
 
 'protect sheets
 myxlapp.Application.worksheets(1).Activate
 myxlapp.Application.worksheets(1).Range("A1").Select
 myxlapp.Run "ProtectSheet"
 
 myxlapp.Application.worksheets(2).Activate
 myxlapp.Application.worksheets(2).Range("A1").Select
 myxlapp.Run "ProtectSheet"
 
 myxlapp.Application.worksheets(1).Activate
 
 
' ExcelSheet.Application.Quit
 
 myxlapp.Application.ActiveWindow.ScrollRow = 1
 
 MyxlBook.Save
 MyxlBook.Application.Quit
  ' Release the object variable
 Set Myxlsheet = Nothing
' Release the object variable
 Set MyxlBook = Nothing
 
 
 myxlapp.Quit  ' When you finish, use the Quit method to close
 myxlapp.Application.DisplayAlerts = True
 Set myxlapp = Nothing ' the application, then release the reference.
 
Exit Sub
 
 
ErrorHandler:   ' Error-handling routine.
   log_file = path & "Log_lsf_data.txt"
 ' log_file = Path & repname & ".TXT"
 ' MsgBox (log_file)
If Err.Number <> 0 Then
   ' Open log_file For Output As #1    ' Open file for output.
   Open log_file For Append As #1    ' Open file for append.
   Print #1, Date; Spc(2); Time; Spc(2); repname; Spc(2); "Code error : "; Err.Number; Spc(2); "descript error : "; Err.Description
   ' Print #1, "Code error : "; Spc(5); Err.Number
   ' Print #1, "descript error : "; Spc(2); Err.Description
  Close #1    ' Close file.
Else
   ' Open log_file For Output As #1    ' Open file for output.
   Open log_file For Append As #1    ' Open file for append.
   Print #1, Date; Spc(2); Time; Spc(2); repname; Spc(2); "Process successful"
   Close #1    ' Close file.
End If
 myxlapp.Quit  ' When you finish, use the Quit method to close
 myxlapp.Application.DisplayAlerts = True
 Set myxlapp = Nothing ' the application, then release the reference.
 
 
 End
 
End Sub

[TomDuBouchon]

Salut,

Je ne vois pas vraiment ce qui bloque dans ce code.

Essaies éventuellement de remplacer "myxlapp.Quit" par "myxlapp.Quit()".

Si ça ne fonctionne pas, mets en commentaire la ligne "myxlapp.Application.DisplayAlerts = False"

Car il y a peut être une erreur qui provoque un arrêt du code et qui bloque sa fermeture.