Discussion :

[zoom61]

Bonjour,

Je gratte et je gratte mais je n'y arrive pas. Excel reste toujours actif !

Mon code est le suivant :

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
'J'initialise mes variables
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open(get_chemin() & get_var())
'Identification de l'onglet
Set db = DAO.OpenDatabase(get_chemin() & get_var(), False, True, "Excel 8.0;")
DoEvents
For Each td In db.TableDefs
   i = set_nom_onglet(Replace(Replace(td.Name, "$", ""), "'", ""))
Next td
Set xlSheet = xlBook.Sheets(get_nom_onglet())
 
'Travaille dans mon fichier Excel, où je supprime des lignes et ou je modifie une cellule
 
'Code de fermeture
Set xlSheet = Nothing
Set td = Nothing
db.Close
Set db = Nothing
xlBook.Save
xlBook.Close (True)
Set xlBook = Nothing
xlApp.Quit
Set xlApp = Nothing

Cela ouvre bien le bon fichier, mais cela ne le ferme pas !

Et je ne vois pas pourquoi cela ne fonctionne pas !

[loufab]

Bonjour,

Il se peut qu'il n'ait pas fini les traitements lorsque tu fermes.

Essaye avec un Doevents avec les nothing et autre close.

Cordialement,

[zoom61]

J'ai essayé :

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
'Code de fermeture
Set xlSheet = Nothing
DoEvents
Set td = Nothing
DoEvents
db.Close
Set db = Nothing
DoEvents
xlBook.Save
xlBook.Close (True)
Set xlBook = Nothing
DoEvents
xlApp.Quit
Set xlApp = Nothing
DoEvents

Mais cela ne change rien !!!

[willcartley]

Salut, j'ai déjà rencontré ce problème et je t'avoue que je n'avais pas trouvé de solution. Mais au cas où çà pourrait t'aider, voici ce que j'utilise maintenant et qui fonctionne correctement:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
    Dim xlApp As Excel.Application
    Dim xlWB As Excel.Workbook
'....
    Set xlApp = New Excel.Application
    With xlApp
        .Visible = False 'si tu veux cacher Excel
        Set xlWB = .Workbooks.Open(Nom_Fichier, , False)
    End With
'...
    xlWB.Close True 'en mettant true tu enregistres en fermant (false si tu ne veux pas le faire)
    Set xlWB = Nothing
    Set xlApp = Nothing

[zoom61]

J'ai essayé ton code, mais cela ne change rien... Dommage !

[zoom61]

Dois-je ajouter des «DoEvents» entre les étapes que je réalise dans Excel en passant par Access

[loufab]

En observant ton code je me pose une question :

Qu'est ce que tu entends par cette ligne de commentaire ?

'Travaille dans mon fichier Excel, où je supprime des lignes et ou je modifie une cellule

[zoom61]

Salut,

Voici le code que je réalise dans 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
'Identification de l'onglet
Set db = DAO.OpenDatabase(get_chemin() & get_var(), False, True, "Excel 8.0;")
DoEvents
For Each td In db.TableDefs
    i = set_nom_onglet(Replace(Replace(td.Name, "$", ""), "'", ""))
Next td
Set xlSheet = xlBook.Sheets(get_nom_onglet())
 
'test pour savoir s'il faut faire la mise à jour du fichier
If xlSheet.Cells(3, 2).Value = 1 Then
    Else
    xlSheet.Range("A1:P10").Delete
    xlSheet.Cells(3, 2) = 1
End If

[batou22003]

Bonjour,

J'ai déjà réussi à faire cela avec les API parce que le code xlApp.close
ne fermait pas mon application.

Un code du genre :

Code :

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

1
2
3
4
5
6
7
8
9
10
Public Function FermerFenetre(stTitreFenetre As String) As Boolean
' Cette fonction ferme la fenêtre dont le titre exact est passé en paramètre.
Dim REP As Long
' Recherche du "handle" de la fenêtre
REP = FindWindow(vbNullString, stTitreFenetre)
If REP Then
' Envoi l'ordre de fermeture à la fenêtre
REP = PostMessage(REP, WM_CLOSE, vbNull, vbNull)
End If
End Function

Je vais pas t'envoyer tout le code mais ca utilise les fonctions :

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA"
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA"

pour fermer les fenetres
ainsi que

Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA"

et ...

Private Declare Function EnumWindows Lib "user32"
Private Declare Function GetWindowRect Lib "user32"
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA"

[zoom61]

Salut,

Le titre s'est quoi, mon fichier a le nom suivant : «c:\chemin\titre.xls»

Je dois mettre quoi dans le «stTitreFenetre» :
1°) titre
2°) titre.xls
3°) c:\chemin\titre.xls

[batou22003]

Ca fait 200 lignes mais bon :
Si tu veux buter une autre appli (wor / Powerpoint) tu changes
le pattern dans EnumWindowProc.
Appel la fonction FermerExcelCommeUneBrute() et ca te ferme tout Excel lancé

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
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
Global ExcelApp() As String
Global Index As Long
 
'Tu doit entrer le nom de la fenetre a fermer exactement comme il est ecrit
'dans cette fenetre ou dans la fenetre qui s'ouvre avec "Ctrl - Alt - Suppr"
 
'FindWindow Recherche le Handle de la fenetre spacifiée dans lpWindowName
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
'PostMessage Envoi l'ordre de fermeture à la fenêtre specifiée par FindWindow
 
 
' Déclaration des API utilisées
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
         (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, _
        ByVal lParam As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
         (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
        ByVal lParam As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, _
        ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
 
' Déclaration de type
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 
'Déclaration de constante
Const WM_CLOSE = &H10
' Variable temporaire utilisée uniquement par la fonction GetWindowsList pour stocker les fenêtres.
Public stGetWindowsList As String
' Nombre de popup supprimées début le lancement
Public lgKill As Long
' Redimensionnement automatique des colonnes du contrôle ListView
Public Const LVM_FIRST = &H1000
Public Const LVM_SETCOLUMNWIDTH = LVM_FIRST + 30
Public Const LVSCW_AUTOSIZE = -1
 
 
Public Function FermerFenetre(stTitreFenetre As String) As Boolean
' Cette fonction ferme la fenêtre dont le titre exact est passé en paramètre.
Dim REP As Long
' Recherche du "handle" de la fenêtre
REP = FindWindow(vbNullString, stTitreFenetre)
If REP Then
' Envoi l'ordre de fermeture à la fenêtre
REP = PostMessage(REP, WM_CLOSE, vbNull, vbNull)
End If
End Function
 
 
Sub FermerExcelCommeUneBrute()
'fermer excel Brutalement
GetWindowsList
FermerExcel
End Sub
 
Sub FermerExcel()
 
On Error GoTo Err_FermerExcel
 
Dim Titre
 
For Each Titre In ExcelApp
FermerFenetre (Titre)
Next
Exit Sub
Err_FermerExcel:
 
End Sub
 
 
Sub TestExcel()
On Error GoTo GetWindowsList
 
Dim Titre
 
For Each Titre In ExcelApp
 
 
MsgBox "Le programme ne fonctionne que si toutes les fenêtre Excel Sont fermées" & Chr(13) & Chr(10) _
& "Veuillez enregistrer les fichiers excel avant de cliquer sur OK", vbCritical, "Enregistrer application Excel"
 
FermerFenetre (Titre)
 
Next
Exit Sub
GetWindowsList:
End Sub
 
 
Public Sub GetWindowsList() 'As Boolean
' Cette fonction retourne sous forme de tableau l'ensemble
' des titres des fenêtres de premier niveau ouvertes sous windows.
Dim lgRep As Long
stGetWindowsList = vbNullString
' Appel de l'API et envoi du pointeur vers notre fonction de rappel
lgRep = EnumWindows(AddressOf EnumWindowsProc, 0)
 
 
End Sub
 
' Déclaration de la fonction de rappel
Public Function EnumWindowsProc(ByVal lgHwnd As Long, ByVal lgParam As Long) As Long
Dim stTmp As String, lgTmp As Long, lgRet As Long
Dim stTmp2 As String, tmpRect As RECT
'stTmp = Space$(201)
stTmp = String(200, Chr$(0))
lgTmp = 200
' On récupère le titre de la fenêtre à partir du handle
lgRet = GetWindowText(lgHwnd, stTmp, lgTmp)
stTmp = Left$(stTmp, InStr(stTmp, Chr$(0)) - 1)
If UCase(stTmp) Like "*MICROSOFT EXCEL*" And Len(stTmp) > Len("MICROSOFT EXCEL") Then
 
ReDim Preserve ExcelApp(Index)
ExcelApp(UBound(ExcelApp)) = stTmp
Index = Index + 1
End If
'MsgBox stTmp
'stTmp = Trim$(Replace(stTmp, Chr$(0), vbNullString))
If (stTmp <> vbNullString) Then
    ' Récupère les dimensions de la fenêtre
    lgRet = GetWindowRect(lgHwnd, tmpRect)
    ' Ajoute les dimensions de la fenêtre à la chaîne retournée
    stTmp = Format$(tmpRect.Right - tmpRect.Left, "00000000") & " " & stTmp
    stTmp = Format$(tmpRect.Bottom - tmpRect.Top, "00000000") & " " & stTmp
End If
If (stTmp <> vbNullString) Then
    stTmp = Format$(lgHwnd, "00000000000;-0000000000") & " " & stTmp
End If
' Stockage du résultat dans la chaine temporaire (ajout au texte existant).
' On pourrait imaginer construire une chaîne plus complexe en ajoutant également le handle
' de la fenêtre, ce qui permettrait des manipulations externes (comme une fermeture par exemple).
If (Trim$(stTmp) <> vbNullString) Then stGetWindowsList = stGetWindowsList & stTmp & vbCrLf
' Retourne 1 systématiquement
EnumWindowsProc = 1
End Function
 
Public Function FileToString(stFile As String) As String
' Lecture d'un fichier et récupération à l'intérieur d'une chaîne unique
' Attention, au ralentissement pour les fichiers de taille importante.
' A n'utiliser que sur les fichiers de type texte.
On Error GoTo errFileToString
Dim inFree As Integer
Dim stTmp As String
inFree = FreeFile
Open stFile For Input Shared As #inFree
stTmp = Input(LOF(inFree), #inFree)
Close #inFree
FileToString = stTmp
Exit Function
errFileToString:
FileToString = vbNullString
End Function
 
Public Function StringToFile(stString As String, stFile As String) As String
' Enregistrement d'une chaine dans un fichier. En cas de réussite la fonction retourne une chaîne vide
' sinon, un message d'erreur.
' Cette fonction est l'inverse de la précédente
Dim inFree As Integer
Dim stTmp As String
On Error GoTo ErrStringToFile
inFree = FreeFile
Open stFile For Output As #inFree
Print #inFree, stString
Close #inFree
StringToFile = vbNullString
Exit Function
ErrStringToFile:
StringToFile = "Erreur (" & Err.Number & "), " & Err.Description
End Function
 
 
 
Public Function InList(Liste) As String
'Public Function InList(lstListe As ListView, stElement As String, Optional blRespecteCasse As Boolean = True) As Long
' Vérifie la présence d'un élément dans une liste
On Error GoTo err_InList
Dim i As Variant
 
 
For i = 0 To 10000
If UCase(Liste(i)) Like "*MICROSOFT EXCEL*" Then
InList = CStr(Liste(i))
Exit Function
End If
Next i
 
Exit Function
err_InList:
 
 
InList = -1
End Function

[zoom61]

Salut,

Je dois avoir un gros problème car cela ne fait rien !!!

Merci quand même

[batou22003]

Il me semble que tu utilises ODBC, pourquoi pas utiliser autre chose pour ouvrir ton Excel?

[batou22003]

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
'tu ajoutes une référence sur les objet Excel : Outil/réferrence/Microsoft Excel 9.0 par ex.
 
'Et tu fais comme ca :
 
Dim xlApp As New Excel.Application
Dim xlWkb As Excel.Workbook
 
 
 
 
Set xlApp = CreateObject("Excel.application")
 
xlApp.Visible = True
 
Set xlWkb = xlApp.Workbooks.Open(CheminTemplateCopy) 'chemin du fichier
 
 
xlApp.Application.DisplayAlerts = False
xlWkb.Sheets("mon onglet").Select
 
'teste et adapte ce truc (utilise les macro Excel pour voir a quoi ca devrait ressembler
if xlApp.Cells(1,1).value=1 then 
Else
    xlSheet.Range("A1:P10").Delete
    xlSheet.Cells(3, 2) = 1
 
end if 
 
'tout ton traitement
 
 
xlApp.ActiveWorkbook.Close
xlApp.Application.DisplayAlerts = False
 
'fermer excel Brutalement
GetWindowsList
FermerExcel
 
'xlApp.Application.Quit
 
 
 
Set xlWkb = Nothing
Set xlApp = Nothing

[Invité]

Bonjour

En lisant cette discussion et les différentes remarques, je constate :

Tu ouvres Excel par Automation

Code :

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

Set xlApp = CreateObject("Excel.Application")

Ensuite (si j'ai toujours bien compris) tu ouvres une connection sur ton fichier Excel déjà ouvert :

Code :

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

Set db = DAO.OpenDatabase(get_chemin() & get_var(), False, True, "Excel 8.0;")

Pourquoi cette connection ?

Qu'est-ce qui t'empêche de tout faire sur la première ?

J'ai l'impression que tu ais en train de mélanger deux types de connections à un fichier Excel.

Starec

[zoom61]

Bonjour

En lisant cette discussion et les différentes remarques, je constate :

Tu ouvres Excel par Automation

Code :

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

Set xlApp = CreateObject("Excel.Application")

Ensuite (si j'ai toujours bien compris) tu ouvres une connection sur ton fichier Excel déjà ouvert :

Code :

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

Set db = DAO.OpenDatabase(get_chemin() & get_var(), False, True, "Excel 8.0;")

Pourquoi cette connection ?

Qu'est-ce qui t'empêche de tout faire sur la première ?

J'ai l'impression que tu ais en train de mélanger deux types de connections à un fichier Excel.

Starec

J'ai récupéré ce code (que j'ai adapté à mon besoin) sur le site, alors je ne sais pas si tout est nécessaire...
Quelles sont les commandes que je pourrai supprimer ?

Merci.

[Invité]

Re

Je pense qu'il faut supprimer tout ce qui est DAO et travaillé par automation.

Sinon, est-ce que tu fais une libération de l'objet db du type :

Code :

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

set db = nothing

Starec

[zoom61]

Mon code est le suivant :

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
Dim xlApp As excel.Application
Dim xlBook As excel.Workbook
Dim xlSheet As excel.Worksheet
Dim db As DAO.Database
Dim td As DAO.TableDef
 
'J'initialise mes variables
Set xlApp = New excel.Application
With xlApp
    .Visible = False 'si tu veux cacher Excel
    Set xlBook = xlApp.Workbooks.Open(get_chemin() & get_var())
End With
 
'Identification de l'onglet
Set db = DAO.OpenDatabase(get_chemin() & get_var(), False, True, "Excel 8.0;")
DoEvents
For Each td In db.TableDefs
    i = set_nom_onglet(Replace(Replace(td.Name, "$", ""), "'", ""))
Next td
Set xlSheet = xlBook.Sheets(get_nom_onglet())
 
'test pour savoir s'il faut faire la mise à jour du fichier
If xlSheet.Cells(3, 2).Value = 1 Then
    Else
    xlSheet.Range("A1:P10").Delete
    xlSheet.Cells(3, 2) = 1
End If
 
'Récupére les données
i = set_j1(Left(xlSheet.Range("C3").Value, Len(xlSheet.Range("C3").Value) - 1) * 1)
i = set_j2(Left(xlSheet.Range("F3").Value, Len(xlSheet.Range("F3").Value) - 1) * 1)
DoCmd.SetWarnings False
DoCmd.RunSQL ("UPDATE table_donnee SET table_donnee.j1 = " & get_j1() & ", table_donnee.j2= " & get_j2() & ";")
DoCmd.SetWarnings True
 
Set xlSheet = Nothing
Set td = Nothing
db.Close
Set db = Nothing
xlBook.Close True 'en mettant true tu enregistres en fermant (false si tu ne veux pas le faire)
Set xlBook = Nothing
Set xlApp = Nothing

Mais si je supprime les éléments DAO, je ne connais plus le nom de l'onglet Où existe-t-il une autre solution

[Invité]

Re

Mais si je supprime les éléments DAO, je ne connais plus le nom de l'onglet Où existe-t-il une autre solution

Je pense que ton problème de fermeture peut provenir du fait que tu utilises deux technologies différentes pour accéder à ton fichier Excel.

J'ai l'impression que tu as pris des bouts de codes à gauche et à droite, et essayé de faire un puzzle.

Je serais toi je me consacrerais sur une seule techno, et par automation.
Ta requête de mise à jour peut être remplacée par une boucle. Je ne suis pas un pro d'Excel, mais je te conseille d'aller faire des recherches dans le forum Excel et la Excel.

Starec

[willcartley]

à essayer à ta sauce :

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
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
'Dim db As DAO.Database
'Dim td As DAO.TableDef
 
Dim j As Integer
 
 
'J'initialise mes variables
Set xlApp = New Excel.Application
With xlApp
    .Visible = False 'si tu veux cacher Excel
    Set xlBook = xlApp.Workbooks.Open(get_chemin() & get_var())
End With
 
'Identification de l'onglet
'Set db = DAO.OpenDatabase(get_chemin() & get_var(), False, True, "Excel 8.0;")
'DoEvents
For j = 1 To xlBook.Worksheets.Count '****ou xlbook.sheets.count à tester
    i = set_nom_onglet(Replace(Replace(xlBook.Worksheets(j).Name, "$", ""), "'", ""))
Next
Set xlSheet = xlBook.Sheets(get_nom_onglet())
 
'test pour savoir s'il faut faire la mise à jour du fichier
If xlSheet.Cells(3, 2).Value = 1 Then
    Else
    xlSheet.Range("A1:P10").Delete
    xlSheet.Cells(3, 2) = 1
End If
'****Là je ne comprend pas trop ce que tu cherches à faire donc....        
'Récupére les données
i = set_j1(Left(xlSheet.Range("C3").Value, Len(xlSheet.Range("C3").Value) - 1) * 1)
i = set_j2(Left(xlSheet.Range("F3").Value, Len(xlSheet.Range("F3").Value) - 1) * 1)
DoCmd.SetWarnings False
DoCmd.RunSQL ("UPDATE table_donnee SET table_donnee.j1 = " & get_j1() & ", table_donnee.j2= " & get_j2() & ";")
DoCmd.SetWarnings True
 
Set xlSheet = Nothing '****Vérifie quand même si c'est bien placé ou si les enregistrements ne sont pas pris en compte
 
'Set td = Nothing
'db.Close
'Set db = Nothing
xlBook.Close True 'en mettant true tu enregistres en fermant (false si tu ne veux pas le faire)
Set xlBook = Nothing
Set xlApp = Nothing