Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Access Automation Excel

Automation Excel

5 réponses
Avatar
Gilbert
Bonjour

Toujours dans l'automation Excel.
Lorsque j'exécute la procédure ci-dessous, j'ai les résultats suivants:
1° essai : OK, mais un process Excel.exe existe encore après la fin de la
procédure.
Si je supprime ce process, au 2° essai, j'ai le message "Le serveur distant
n'existe pas ou n'est pas disponible"
Si je ne le supprime pas, au 2° essai j'ai le message "Variable objet ou
variable de bloc with non définie"

Si je ferme Access (ou même simplement ma base de données sans fermer
Access) après le 1° essai, le process Excel est supprimé en même temps.

Lorsque je redémarre Access, le 1° essai fonctionne,.... etc
Précision : lors du 2° essai, le process Excel est créé, puis est supprimé
après que j'ai cliqué OK dans le message d'erreur, mais les essais suivants
ne fonctionnent pas mieux.

Qu'est-ce que j'ai oublié?

Merci d'avance

Gilbert


Voici le code de ma procédure

Public Function AccessToExcelAutomation()
Const NbLignesAjoutees = 5
Dim rst As DAO.Recordset
Dim intCurrTask As Integer
Dim XL_Classeur As Excel.Workbook
Dim XL_Feuille As Excel.Worksheet
Dim rngCurr As Excel.Range
Dim fld As Field
Dim varColonne As Byte
Dim i As Integer
Dim j As Integer
Dim strtmp As String

On Error GoTo ErrorOLEAccessToExcel

Set rst = CurrentDb.OpenRecordset("Rqte_Tmp")
Set XL_App = CreateObject("Excel.Application")
Set XL_Classeur = XL_App.Workbooks.Open("D:\Mes
documents\Gilbert\Greta\Modèles\Modèle Heures.xlt")
Set XL_Feuille = XL_App.Sheets("Feuil1")

With XL_Feuille '-- Création des en-têtes de colonnes
varColonne = 1
For Each fld In rst.Fields
.Cells(1, varColonne).Value = fld.Name
varColonne = varColonne + 1
Next
End With

rst.MoveLast
rst.MoveFirst
'Copie des données
Set rngCurr = XL_Feuille.Range(XL_Feuille.Cells(3, 1), XL_Feuille.Cells(2 +
rst.RecordCount, 3))
rngCurr.CopyFromRecordset rst

'Début du traitement du fichier
Excel ----------------------------------------------------------------------
-
XL_Feuille.Columns("A:E").AutoFit
XL_Feuille.Columns("F:ZZ").ColumnWidth = 6
XL_Feuille.Rows("1:1").AutoFit
XL_Feuille.Cells(2, 2) = XL_Feuille.Cells(3, 1)
XL_Feuille.Cells(2, 2).Font.Bold = True
XL_Feuille.Cells(2, 2).Font.Italic = True
XL_Feuille.Cells(2, 2).Font.Size = 14
strtmp = XL_Feuille.Cells(3, 1)
i = 4
Do While XL_Feuille.Cells(i, 1) <> ""
If XL_Feuille.Cells(i, 1).Value <> strtmp Then
strtmp = XL_Feuille.Cells(i, 1)
XL_Feuille.Select
XL_Feuille.Rows(i & ":" & i).Select
For j = 1 To NbLignesAjoutees
'===========================================================================
'C'est lors du premier passage sur cette ligne que se produisent les erreurs
Selection.Insert Shift:=xlUp

'===========================================================================
Next j
i = i + NbLignesAjoutees
XL_Feuille.Cells(i - 1, 2) = XL_Feuille.Cells(i, 1)
strtmp = XL_Feuille.Cells(i, 1)
XL_Feuille.Cells(i - 1, 2).Font.Bold = True
XL_Feuille.Cells(i - 1, 2).Font.Italic = True
XL_Feuille.Cells(i - 1, 2).Font.Size = 14
Rows(i - 1 & ":" & i - 1).Select
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End If
i = i + 1
Loop
XL_Feuille.Select
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
XL_Feuille.Cells(1, 1) = "Heures " & Chr(10) & "réalisées " & Chr(10) &
MoisAnnee_Complet
With XL_Feuille.PageSetup
.RightFooter = "Page &P sur &N"
.LeftMargin = 0
.RightMargin = 0
.TopMargin = 0
.BottomMargin = 1
.HeaderMargin = 0
.FooterMargin = 0
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
End With

'Fin du traitement du fichier
Excel ----------------------------------------------------------------------
-

XL_App.Visible = True

FinSub:
XL_App.DisplayAlerts = False
XL_App.ActiveWorkbook.SaveAs ("Heures réalisées " & MoisAnnee_Complet)
XL_App.DisplayAlerts = True
XL_App.ActiveWorkbook.Close
Set XL_Feuille = Nothing
Set XL_Classeur = Nothing
Set XL_App = Nothing
Exit Function

ErrorOLEAccessToExcel:
Beep
MsgBox "The Following OLE Error has occurred:" & vbCrLf &
err.Description, vbCritical, "OLE Error!"
Resume FinSub
End Function
Signaler un problème avec ce contenu

5 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Pierre CFI [mvp]
bonjour
je vois pas de XL_App.Quit, je vois pas d'ailleurs de déclaration de XL_App

--
Pierre CFI
MVP Microsoft Access
Mail : http://cerbermail.com/?z0SN8cN53B

Site pour bien commencer
http://users.skynet.be/mpfa/
Site perso
http://access.cfi.free.fr
"Gilbert" a écrit dans le message de news: uRYh#
Bonjour

Toujours dans l'automation Excel.
Lorsque j'exécute la procédure ci-dessous, j'ai les résultats suivants:
1° essai : OK, mais un process Excel.exe existe encore après la fin de la
procédure.
Si je supprime ce process, au 2° essai, j'ai le message "Le serveur distant
n'existe pas ou n'est pas disponible"
Si je ne le supprime pas, au 2° essai j'ai le message "Variable objet ou
variable de bloc with non définie"

Si je ferme Access (ou même simplement ma base de données sans fermer
Access) après le 1° essai, le process Excel est supprimé en même temps.

Lorsque je redémarre Access, le 1° essai fonctionne,.... etc
Précision : lors du 2° essai, le process Excel est créé, puis est supprimé
après que j'ai cliqué OK dans le message d'erreur, mais les essais suivants
ne fonctionnent pas mieux.

Qu'est-ce que j'ai oublié?

Merci d'avance

Gilbert


Voici le code de ma procédure

Public Function AccessToExcelAutomation()
Const NbLignesAjoutees = 5
Dim rst As DAO.Recordset
Dim intCurrTask As Integer
Dim XL_Classeur As Excel.Workbook
Dim XL_Feuille As Excel.Worksheet
Dim rngCurr As Excel.Range
Dim fld As Field
Dim varColonne As Byte
Dim i As Integer
Dim j As Integer
Dim strtmp As String

On Error GoTo ErrorOLEAccessToExcel

Set rst = CurrentDb.OpenRecordset("Rqte_Tmp")
Set XL_App = CreateObject("Excel.Application")
Set XL_Classeur = XL_App.Workbooks.Open("D:Mes
documentsGilbertGretaModèlesModèle Heures.xlt")
Set XL_Feuille = XL_App.Sheets("Feuil1")

With XL_Feuille '-- Création des en-têtes de colonnes
varColonne = 1
For Each fld In rst.Fields
.Cells(1, varColonne).Value = fld.Name
varColonne = varColonne + 1
Next
End With

rst.MoveLast
rst.MoveFirst
'Copie des données
Set rngCurr = XL_Feuille.Range(XL_Feuille.Cells(3, 1), XL_Feuille.Cells(2 +
rst.RecordCount, 3))
rngCurr.CopyFromRecordset rst

'Début du traitement du fichier
Excel ----------------------------------------------------------------------
-
XL_Feuille.Columns("A:E").AutoFit
XL_Feuille.Columns("F:ZZ").ColumnWidth = 6
XL_Feuille.Rows("1:1").AutoFit
XL_Feuille.Cells(2, 2) = XL_Feuille.Cells(3, 1)
XL_Feuille.Cells(2, 2).Font.Bold = True
XL_Feuille.Cells(2, 2).Font.Italic = True
XL_Feuille.Cells(2, 2).Font.Size = 14
strtmp = XL_Feuille.Cells(3, 1)
i = 4
Do While XL_Feuille.Cells(i, 1) <> ""
If XL_Feuille.Cells(i, 1).Value <> strtmp Then
strtmp = XL_Feuille.Cells(i, 1)
XL_Feuille.Select
XL_Feuille.Rows(i & ":" & i).Select
For j = 1 To NbLignesAjoutees
'========================================================================== > 'C'est lors du premier passage sur cette ligne que se produisent les erreurs
Selection.Insert Shift:=xlUp

'========================================================================== > Next j
i = i + NbLignesAjoutees
XL_Feuille.Cells(i - 1, 2) = XL_Feuille.Cells(i, 1)
strtmp = XL_Feuille.Cells(i, 1)
XL_Feuille.Cells(i - 1, 2).Font.Bold = True
XL_Feuille.Cells(i - 1, 2).Font.Italic = True
XL_Feuille.Cells(i - 1, 2).Font.Size = 14
Rows(i - 1 & ":" & i - 1).Select
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End If
i = i + 1
Loop
XL_Feuille.Select
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
XL_Feuille.Cells(1, 1) = "Heures " & Chr(10) & "réalisées " & Chr(10) &
MoisAnnee_Complet
With XL_Feuille.PageSetup
.RightFooter = "Page &P sur &N"
.LeftMargin = 0
.RightMargin = 0
.TopMargin = 0
.BottomMargin = 1
.HeaderMargin = 0
.FooterMargin = 0
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
End With

'Fin du traitement du fichier
Excel ----------------------------------------------------------------------
-

XL_App.Visible = True

FinSub:
XL_App.DisplayAlerts = False
XL_App.ActiveWorkbook.SaveAs ("Heures réalisées " & MoisAnnee_Complet)
XL_App.DisplayAlerts = True
XL_App.ActiveWorkbook.Close
Set XL_Feuille = Nothing
Set XL_Classeur = Nothing
Set XL_App = Nothing
Exit Function

ErrorOLEAccessToExcel:
Beep
MsgBox "The Following OLE Error has occurred:" & vbCrLf &
err.Description, vbCritical, "OLE Error!"
Resume FinSub
End Function




Avatar
Gilbert
Bonjour Pierre et merci de ta réponse.
La déclaration est publique dans un autre module.
Pour la fermeture j'utilise XL_App.ActiveWorkbook.Close.
J'ai ajouté la ligne XL_App.Quit, mais ça ne change rien au problème.

Gilbert

"Pierre CFI [mvp]" a écrit dans le message de
news:
bonjour
je vois pas de XL_App.Quit, je vois pas d'ailleurs de déclaration de
XL_App


--
Pierre CFI
MVP Microsoft Access
Mail : http://cerbermail.com/?z0SN8cN53B

Site pour bien commencer
http://users.skynet.be/mpfa/
Site perso
http://access.cfi.free.fr
"Gilbert" a écrit dans le message de news:
uRYh#

Bonjour

Toujours dans l'automation Excel.
Lorsque j'exécute la procédure ci-dessous, j'ai les résultats suivants:
1° essai : OK, mais un process Excel.exe existe encore après la fin de
la


procédure.
Si je supprime ce process, au 2° essai, j'ai le message "Le serveur
distant


n'existe pas ou n'est pas disponible"
Si je ne le supprime pas, au 2° essai j'ai le message "Variable objet ou
variable de bloc with non définie"

Si je ferme Access (ou même simplement ma base de données sans fermer
Access) après le 1° essai, le process Excel est supprimé en même temps.

Lorsque je redémarre Access, le 1° essai fonctionne,.... etc
Précision : lors du 2° essai, le process Excel est créé, puis est
supprimé


après que j'ai cliqué OK dans le message d'erreur, mais les essais
suivants


ne fonctionnent pas mieux.

Qu'est-ce que j'ai oublié?

Merci d'avance

Gilbert


Voici le code de ma procédure

Public Function AccessToExcelAutomation()
Const NbLignesAjoutees = 5
Dim rst As DAO.Recordset
Dim intCurrTask As Integer
Dim XL_Classeur As Excel.Workbook
Dim XL_Feuille As Excel.Worksheet
Dim rngCurr As Excel.Range
Dim fld As Field
Dim varColonne As Byte
Dim i As Integer
Dim j As Integer
Dim strtmp As String

On Error GoTo ErrorOLEAccessToExcel

Set rst = CurrentDb.OpenRecordset("Rqte_Tmp")
Set XL_App = CreateObject("Excel.Application")
Set XL_Classeur = XL_App.Workbooks.Open("D:Mes
documentsGilbertGretaModèlesModèle Heures.xlt")
Set XL_Feuille = XL_App.Sheets("Feuil1")

With XL_Feuille '-- Création des en-têtes de colonnes
varColonne = 1
For Each fld In rst.Fields
.Cells(1, varColonne).Value = fld.Name
varColonne = varColonne + 1
Next
End With

rst.MoveLast
rst.MoveFirst
'Copie des données
Set rngCurr = XL_Feuille.Range(XL_Feuille.Cells(3, 1),
XL_Feuille.Cells(2 +


rst.RecordCount, 3))
rngCurr.CopyFromRecordset rst

'Début du traitement du fichier

Excel ----------------------------------------------------------------------


-
XL_Feuille.Columns("A:E").AutoFit
XL_Feuille.Columns("F:ZZ").ColumnWidth = 6
XL_Feuille.Rows("1:1").AutoFit
XL_Feuille.Cells(2, 2) = XL_Feuille.Cells(3, 1)
XL_Feuille.Cells(2, 2).Font.Bold = True
XL_Feuille.Cells(2, 2).Font.Italic = True
XL_Feuille.Cells(2, 2).Font.Size = 14
strtmp = XL_Feuille.Cells(3, 1)
i = 4
Do While XL_Feuille.Cells(i, 1) <> ""
If XL_Feuille.Cells(i, 1).Value <> strtmp Then
strtmp = XL_Feuille.Cells(i, 1)
XL_Feuille.Select
XL_Feuille.Rows(i & ":" & i).Select
For j = 1 To NbLignesAjoutees

'========================================================================== > > 'C'est lors du premier passage sur cette ligne que se produisent les


erreurs
Selection.Insert Shift:=xlUp


'========================================================================== > > Next j


i = i + NbLignesAjoutees
XL_Feuille.Cells(i - 1, 2) = XL_Feuille.Cells(i, 1)
strtmp = XL_Feuille.Cells(i, 1)
XL_Feuille.Cells(i - 1, 2).Font.Bold = True
XL_Feuille.Cells(i - 1, 2).Font.Italic = True
XL_Feuille.Cells(i - 1, 2).Font.Size = 14
Rows(i - 1 & ":" & i - 1).Select
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End If
i = i + 1
Loop
XL_Feuille.Select
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
XL_Feuille.Cells(1, 1) = "Heures " & Chr(10) & "réalisées " & Chr(10) &
MoisAnnee_Complet
With XL_Feuille.PageSetup
.RightFooter = "Page &P sur &N"
.LeftMargin = 0
.RightMargin = 0
.TopMargin = 0
.BottomMargin = 1
.HeaderMargin = 0
.FooterMargin = 0
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
End With

'Fin du traitement du fichier

Excel ----------------------------------------------------------------------


-

XL_App.Visible = True

FinSub:
XL_App.DisplayAlerts = False
XL_App.ActiveWorkbook.SaveAs ("Heures réalisées " &
MoisAnnee_Complet)


XL_App.DisplayAlerts = True
XL_App.ActiveWorkbook.Close
Set XL_Feuille = Nothing
Set XL_Classeur = Nothing
Set XL_App = Nothing
Exit Function

ErrorOLEAccessToExcel:
Beep
MsgBox "The Following OLE Error has occurred:" & vbCrLf &
err.Description, vbCritical, "OLE Error!"
Resume FinSub
End Function








Avatar
Pierre CFI [mvp]
bonjour
sinon va entre autre ici
http://rp.developpez.com/vb/tutoriels/faq/?page=Systeme#tuer_process

--
Pierre CFI
MVP Microsoft Access
Mail : http://cerbermail.com/?z0SN8cN53B

Site pour bien commencer
http://users.skynet.be/mpfa/
Site perso
http://access.cfi.free.fr
"Gilbert" a écrit dans le message de news: #YSEG$
Bonjour Pierre et merci de ta réponse.
La déclaration est publique dans un autre module.
Pour la fermeture j'utilise XL_App.ActiveWorkbook.Close.
J'ai ajouté la ligne XL_App.Quit, mais ça ne change rien au problème.

Gilbert

"Pierre CFI [mvp]" a écrit dans le message de
news:
bonjour
je vois pas de XL_App.Quit, je vois pas d'ailleurs de déclaration de
XL_App


--
Pierre CFI
MVP Microsoft Access
Mail : http://cerbermail.com/?z0SN8cN53B

Site pour bien commencer
http://users.skynet.be/mpfa/
Site perso
http://access.cfi.free.fr
"Gilbert" a écrit dans le message de news:
uRYh#

Bonjour

Toujours dans l'automation Excel.
Lorsque j'exécute la procédure ci-dessous, j'ai les résultats suivants:
1° essai : OK, mais un process Excel.exe existe encore après la fin de
la


procédure.
Si je supprime ce process, au 2° essai, j'ai le message "Le serveur
distant


n'existe pas ou n'est pas disponible"
Si je ne le supprime pas, au 2° essai j'ai le message "Variable objet ou
variable de bloc with non définie"

Si je ferme Access (ou même simplement ma base de données sans fermer
Access) après le 1° essai, le process Excel est supprimé en même temps.

Lorsque je redémarre Access, le 1° essai fonctionne,.... etc
Précision : lors du 2° essai, le process Excel est créé, puis est
supprimé


après que j'ai cliqué OK dans le message d'erreur, mais les essais
suivants


ne fonctionnent pas mieux.

Qu'est-ce que j'ai oublié?

Merci d'avance

Gilbert


Voici le code de ma procédure

Public Function AccessToExcelAutomation()
Const NbLignesAjoutees = 5
Dim rst As DAO.Recordset
Dim intCurrTask As Integer
Dim XL_Classeur As Excel.Workbook
Dim XL_Feuille As Excel.Worksheet
Dim rngCurr As Excel.Range
Dim fld As Field
Dim varColonne As Byte
Dim i As Integer
Dim j As Integer
Dim strtmp As String

On Error GoTo ErrorOLEAccessToExcel

Set rst = CurrentDb.OpenRecordset("Rqte_Tmp")
Set XL_App = CreateObject("Excel.Application")
Set XL_Classeur = XL_App.Workbooks.Open("D:Mes
documentsGilbertGretaModèlesModèle Heures.xlt")
Set XL_Feuille = XL_App.Sheets("Feuil1")

With XL_Feuille '-- Création des en-têtes de colonnes
varColonne = 1
For Each fld In rst.Fields
.Cells(1, varColonne).Value = fld.Name
varColonne = varColonne + 1
Next
End With

rst.MoveLast
rst.MoveFirst
'Copie des données
Set rngCurr = XL_Feuille.Range(XL_Feuille.Cells(3, 1),
XL_Feuille.Cells(2 +


rst.RecordCount, 3))
rngCurr.CopyFromRecordset rst

'Début du traitement du fichier

Excel ----------------------------------------------------------------------


-
XL_Feuille.Columns("A:E").AutoFit
XL_Feuille.Columns("F:ZZ").ColumnWidth = 6
XL_Feuille.Rows("1:1").AutoFit
XL_Feuille.Cells(2, 2) = XL_Feuille.Cells(3, 1)
XL_Feuille.Cells(2, 2).Font.Bold = True
XL_Feuille.Cells(2, 2).Font.Italic = True
XL_Feuille.Cells(2, 2).Font.Size = 14
strtmp = XL_Feuille.Cells(3, 1)
i = 4
Do While XL_Feuille.Cells(i, 1) <> ""
If XL_Feuille.Cells(i, 1).Value <> strtmp Then
strtmp = XL_Feuille.Cells(i, 1)
XL_Feuille.Select
XL_Feuille.Rows(i & ":" & i).Select
For j = 1 To NbLignesAjoutees

'========================================================================== > > > 'C'est lors du premier passage sur cette ligne que se produisent les


erreurs
Selection.Insert Shift:=xlUp


'========================================================================== > > > Next j


i = i + NbLignesAjoutees
XL_Feuille.Cells(i - 1, 2) = XL_Feuille.Cells(i, 1)
strtmp = XL_Feuille.Cells(i, 1)
XL_Feuille.Cells(i - 1, 2).Font.Bold = True
XL_Feuille.Cells(i - 1, 2).Font.Italic = True
XL_Feuille.Cells(i - 1, 2).Font.Size = 14
Rows(i - 1 & ":" & i - 1).Select
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End If
i = i + 1
Loop
XL_Feuille.Select
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
XL_Feuille.Cells(1, 1) = "Heures " & Chr(10) & "réalisées " & Chr(10) &
MoisAnnee_Complet
With XL_Feuille.PageSetup
.RightFooter = "Page &P sur &N"
.LeftMargin = 0
.RightMargin = 0
.TopMargin = 0
.BottomMargin = 1
.HeaderMargin = 0
.FooterMargin = 0
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
End With

'Fin du traitement du fichier

Excel ----------------------------------------------------------------------


-

XL_App.Visible = True

FinSub:
XL_App.DisplayAlerts = False
XL_App.ActiveWorkbook.SaveAs ("Heures réalisées " &
MoisAnnee_Complet)


XL_App.DisplayAlerts = True
XL_App.ActiveWorkbook.Close
Set XL_Feuille = Nothing
Set XL_Classeur = Nothing
Set XL_App = Nothing
Exit Function

ErrorOLEAccessToExcel:
Beep
MsgBox "The Following OLE Error has occurred:" & vbCrLf &
err.Description, vbCritical, "OLE Error!"
Resume FinSub
End Function












Avatar
Gilbert
Merci de la piste. Je vais voir ce que je peux en faire. Car je ne voudrais
pas supprimer un process Excel que je n'ai pas lancé par mon code.

Sinon depuis j'ai découvert que ce sont les commandes Selection.xxxxx qui
posent problème.
Si j'exécute ma procédure sans ces lignes, tout fonctionne normalement et
autant de fois que je veux. Le process Excel est bien supprimé lorsque je
ferme la fenêtre.
Si j'utilise Selection.Delete ou Selection.Insert le problème apparait de
nouveau.
Je continue à chercher.
Si tu as d'autres idées....

Gilbert
"Pierre CFI [mvp]" a écrit dans le message de
news: #b6u7$
bonjour
sinon va entre autre ici
http://rp.developpez.com/vb/tutoriels/faq/?page=Systeme#tuer_process

--
Pierre CFI
MVP Microsoft Access
Mail : http://cerbermail.com/?z0SN8cN53B

Site pour bien commencer
http://users.skynet.be/mpfa/
Site perso
http://access.cfi.free.fr
"Gilbert" a écrit dans le message de news:
#YSEG$

Bonjour Pierre et merci de ta réponse.
La déclaration est publique dans un autre module.
Pour la fermeture j'utilise XL_App.ActiveWorkbook.Close.
J'ai ajouté la ligne XL_App.Quit, mais ça ne change rien au problème.

Gilbert

"Pierre CFI [mvp]" a écrit dans le message de
news:
bonjour
je vois pas de XL_App.Quit, je vois pas d'ailleurs de déclaration de
XL_App


--
Pierre CFI
MVP Microsoft Access
Mail : http://cerbermail.com/?z0SN8cN53B

Site pour bien commencer
http://users.skynet.be/mpfa/
Site perso
http://access.cfi.free.fr
"Gilbert" a écrit dans le message de news:
uRYh#

Bonjour

Toujours dans l'automation Excel.
Lorsque j'exécute la procédure ci-dessous, j'ai les résultats
suivants:




1° essai : OK, mais un process Excel.exe existe encore après la fin
de




la
procédure.
Si je supprime ce process, au 2° essai, j'ai le message "Le serveur
distant


n'existe pas ou n'est pas disponible"
Si je ne le supprime pas, au 2° essai j'ai le message "Variable
objet ou




variable de bloc with non définie"

Si je ferme Access (ou même simplement ma base de données sans
fermer




Access) après le 1° essai, le process Excel est supprimé en même
temps.





Lorsque je redémarre Access, le 1° essai fonctionne,.... etc
Précision : lors du 2° essai, le process Excel est créé, puis est
supprimé


après que j'ai cliqué OK dans le message d'erreur, mais les essais
suivants


ne fonctionnent pas mieux.

Qu'est-ce que j'ai oublié?

Merci d'avance

Gilbert


Voici le code de ma procédure

Public Function AccessToExcelAutomation()
Const NbLignesAjoutees = 5
Dim rst As DAO.Recordset
Dim intCurrTask As Integer
Dim XL_Classeur As Excel.Workbook
Dim XL_Feuille As Excel.Worksheet
Dim rngCurr As Excel.Range
Dim fld As Field
Dim varColonne As Byte
Dim i As Integer
Dim j As Integer
Dim strtmp As String

On Error GoTo ErrorOLEAccessToExcel

Set rst = CurrentDb.OpenRecordset("Rqte_Tmp")
Set XL_App = CreateObject("Excel.Application")
Set XL_Classeur = XL_App.Workbooks.Open("D:Mes
documentsGilbertGretaModèlesModèle Heures.xlt")
Set XL_Feuille = XL_App.Sheets("Feuil1")

With XL_Feuille '-- Création des en-têtes de colonnes
varColonne = 1
For Each fld In rst.Fields
.Cells(1, varColonne).Value = fld.Name
varColonne = varColonne + 1
Next
End With

rst.MoveLast
rst.MoveFirst
'Copie des données
Set rngCurr = XL_Feuille.Range(XL_Feuille.Cells(3, 1),
XL_Feuille.Cells(2 +


rst.RecordCount, 3))
rngCurr.CopyFromRecordset rst

'Début du traitement du fichier




Excel ----------------------------------------------------------------------


-
XL_Feuille.Columns("A:E").AutoFit
XL_Feuille.Columns("F:ZZ").ColumnWidth = 6
XL_Feuille.Rows("1:1").AutoFit
XL_Feuille.Cells(2, 2) = XL_Feuille.Cells(3, 1)
XL_Feuille.Cells(2, 2).Font.Bold = True
XL_Feuille.Cells(2, 2).Font.Italic = True
XL_Feuille.Cells(2, 2).Font.Size = 14
strtmp = XL_Feuille.Cells(3, 1)
i = 4
Do While XL_Feuille.Cells(i, 1) <> ""
If XL_Feuille.Cells(i, 1).Value <> strtmp Then
strtmp = XL_Feuille.Cells(i, 1)
XL_Feuille.Select
XL_Feuille.Rows(i & ":" & i).Select
For j = 1 To NbLignesAjoutees




'========================================================================== > > > > 'C'est lors du premier passage sur cette ligne que se produisent les


erreurs
Selection.Insert Shift:=xlUp





'========================================================================== > > > > Next j


i = i + NbLignesAjoutees
XL_Feuille.Cells(i - 1, 2) = XL_Feuille.Cells(i, 1)
strtmp = XL_Feuille.Cells(i, 1)
XL_Feuille.Cells(i - 1, 2).Font.Bold = True
XL_Feuille.Cells(i - 1, 2).Font.Italic = True
XL_Feuille.Cells(i - 1, 2).Font.Size = 14
Rows(i - 1 & ":" & i - 1).Select
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End If
i = i + 1
Loop
XL_Feuille.Select
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
XL_Feuille.Cells(1, 1) = "Heures " & Chr(10) & "réalisées " &
Chr(10) &




MoisAnnee_Complet
With XL_Feuille.PageSetup
.RightFooter = "Page &P sur &N"
.LeftMargin = 0
.RightMargin = 0
.TopMargin = 0
.BottomMargin = 1
.HeaderMargin = 0
.FooterMargin = 0
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
End With

'Fin du traitement du fichier




Excel ----------------------------------------------------------------------


-

XL_App.Visible = True

FinSub:
XL_App.DisplayAlerts = False
XL_App.ActiveWorkbook.SaveAs ("Heures réalisées " &
MoisAnnee_Complet)


XL_App.DisplayAlerts = True
XL_App.ActiveWorkbook.Close
Set XL_Feuille = Nothing
Set XL_Classeur = Nothing
Set XL_App = Nothing
Exit Function

ErrorOLEAccessToExcel:
Beep
MsgBox "The Following OLE Error has occurred:" & vbCrLf &
err.Description, vbCritical, "OLE Error!"
Resume FinSub
End Function
















Avatar
Gilbert
Rebonsoir
J'ai trouvé une solution à mon problème.

J'ai supprimé les commandes de mise en forme qui posaient problème dans ma
procédure et j'en ai fait une macro Excel que j'exécute depuis ma procédure
avec :
XL_App.Application.Run "'Modèle Heures1'!Macro1"

Et dans ce cas tout fonctionne correctement, le process Excel se termine
normalement.

Merci à tous
Gilbert
"Pierre CFI [mvp]" a écrit dans le message de
news: #b6u7$
bonjour
sinon va entre autre ici
http://rp.developpez.com/vb/tutoriels/faq/?page=Systeme#tuer_process

--
Pierre CFI
MVP Microsoft Access
Mail : http://cerbermail.com/?z0SN8cN53B

Site pour bien commencer
http://users.skynet.be/mpfa/
Site perso
http://access.cfi.free.fr
"Gilbert" a écrit dans le message de news:
#YSEG$

Bonjour Pierre et merci de ta réponse.
La déclaration est publique dans un autre module.
Pour la fermeture j'utilise XL_App.ActiveWorkbook.Close.
J'ai ajouté la ligne XL_App.Quit, mais ça ne change rien au problème.

Gilbert

"Pierre CFI [mvp]" a écrit dans le message de
news:
bonjour
je vois pas de XL_App.Quit, je vois pas d'ailleurs de déclaration de
XL_App


--
Pierre CFI
MVP Microsoft Access
Mail : http://cerbermail.com/?z0SN8cN53B

Site pour bien commencer
http://users.skynet.be/mpfa/
Site perso
http://access.cfi.free.fr
"Gilbert" a écrit dans le message de news:
uRYh#

Bonjour

Toujours dans l'automation Excel.
Lorsque j'exécute la procédure ci-dessous, j'ai les résultats
suivants:




1° essai : OK, mais un process Excel.exe existe encore après la fin
de




la
procédure.
Si je supprime ce process, au 2° essai, j'ai le message "Le serveur
distant


n'existe pas ou n'est pas disponible"
Si je ne le supprime pas, au 2° essai j'ai le message "Variable
objet ou




variable de bloc with non définie"

Si je ferme Access (ou même simplement ma base de données sans
fermer




Access) après le 1° essai, le process Excel est supprimé en même
temps.





Lorsque je redémarre Access, le 1° essai fonctionne,.... etc
Précision : lors du 2° essai, le process Excel est créé, puis est
supprimé


après que j'ai cliqué OK dans le message d'erreur, mais les essais
suivants


ne fonctionnent pas mieux.

Qu'est-ce que j'ai oublié?

Merci d'avance

Gilbert


Voici le code de ma procédure

Public Function AccessToExcelAutomation()
Const NbLignesAjoutees = 5
Dim rst As DAO.Recordset
Dim intCurrTask As Integer
Dim XL_Classeur As Excel.Workbook
Dim XL_Feuille As Excel.Worksheet
Dim rngCurr As Excel.Range
Dim fld As Field
Dim varColonne As Byte
Dim i As Integer
Dim j As Integer
Dim strtmp As String

On Error GoTo ErrorOLEAccessToExcel

Set rst = CurrentDb.OpenRecordset("Rqte_Tmp")
Set XL_App = CreateObject("Excel.Application")
Set XL_Classeur = XL_App.Workbooks.Open("D:Mes
documentsGilbertGretaModèlesModèle Heures.xlt")
Set XL_Feuille = XL_App.Sheets("Feuil1")

With XL_Feuille '-- Création des en-têtes de colonnes
varColonne = 1
For Each fld In rst.Fields
.Cells(1, varColonne).Value = fld.Name
varColonne = varColonne + 1
Next
End With

rst.MoveLast
rst.MoveFirst
'Copie des données
Set rngCurr = XL_Feuille.Range(XL_Feuille.Cells(3, 1),
XL_Feuille.Cells(2 +


rst.RecordCount, 3))
rngCurr.CopyFromRecordset rst

'Début du traitement du fichier




Excel ----------------------------------------------------------------------


-
XL_Feuille.Columns("A:E").AutoFit
XL_Feuille.Columns("F:ZZ").ColumnWidth = 6
XL_Feuille.Rows("1:1").AutoFit
XL_Feuille.Cells(2, 2) = XL_Feuille.Cells(3, 1)
XL_Feuille.Cells(2, 2).Font.Bold = True
XL_Feuille.Cells(2, 2).Font.Italic = True
XL_Feuille.Cells(2, 2).Font.Size = 14
strtmp = XL_Feuille.Cells(3, 1)
i = 4
Do While XL_Feuille.Cells(i, 1) <> ""
If XL_Feuille.Cells(i, 1).Value <> strtmp Then
strtmp = XL_Feuille.Cells(i, 1)
XL_Feuille.Select
XL_Feuille.Rows(i & ":" & i).Select
For j = 1 To NbLignesAjoutees




'========================================================================== > > > > 'C'est lors du premier passage sur cette ligne que se produisent les


erreurs
Selection.Insert Shift:=xlUp





'========================================================================== > > > > Next j


i = i + NbLignesAjoutees
XL_Feuille.Cells(i - 1, 2) = XL_Feuille.Cells(i, 1)
strtmp = XL_Feuille.Cells(i, 1)
XL_Feuille.Cells(i - 1, 2).Font.Bold = True
XL_Feuille.Cells(i - 1, 2).Font.Italic = True
XL_Feuille.Cells(i - 1, 2).Font.Size = 14
Rows(i - 1 & ":" & i - 1).Select
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End If
i = i + 1
Loop
XL_Feuille.Select
Columns("A:A").Select
Selection.Delete Shift:=xlToLeft
XL_Feuille.Cells(1, 1) = "Heures " & Chr(10) & "réalisées " &
Chr(10) &




MoisAnnee_Complet
With XL_Feuille.PageSetup
.RightFooter = "Page &P sur &N"
.LeftMargin = 0
.RightMargin = 0
.TopMargin = 0
.BottomMargin = 1
.HeaderMargin = 0
.FooterMargin = 0
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
End With

'Fin du traitement du fichier




Excel ----------------------------------------------------------------------


-

XL_App.Visible = True

FinSub:
XL_App.DisplayAlerts = False
XL_App.ActiveWorkbook.SaveAs ("Heures réalisées " &
MoisAnnee_Complet)


XL_App.DisplayAlerts = True
XL_App.ActiveWorkbook.Close
Set XL_Feuille = Nothing
Set XL_Classeur = Nothing
Set XL_App = Nothing
Exit Function

ErrorOLEAccessToExcel:
Beep
MsgBox "The Following OLE Error has occurred:" & vbCrLf &
err.Description, vbCritical, "OLE Error!"
Resume FinSub
End Function