Sujet Précédent Sujet Suivant

Problème avec des objets Excel.

alebib Messages postés 10 Date d'inscription mercredi 3 mars 2004 Statut Membre Dernière intervention 28 juillet 2005 - 8 juil. 2004 à 14:27
cs_PhilippeE Messages postés 437 Date d'inscription mercredi 18 décembre 2002 Statut Membre Dernière intervention 10 août 2010 - 8 juil. 2004 à 18:37
Bonjour,

J'utilise dans une procédure des objets pour aller chercher le contenu de cellules dans un fichier Excel. J'utlise les objets :

Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet

Quand ma procédure se termine et que je vais voir dans le gestionnaire de tâche il y a toujours en mémoire le "Excel.exe". Si exécute ma procédure plusieurs fois alors il y a un nouveau "Excel.exe" qui s'ajoute à chaque reprise de ma procédure. De plus ma procédure ne fonctionne plus correctement.

Quelqu'un peu m'aider?? SVP

7 réponses

Réponse 1 / 7
pystag Messages postés 13 Date d'inscription lundi 3 mai 2004 Statut Membre Dernière intervention 27 mai 2005
8 juil. 2004 à 14:42
Avec ça, ça devrait marcher

/****

xlBook.Close(False)
xlSheet = Nothing
xlBook= Nothing
xlApp.Quit()
xlApp = Nothing

/****
pystag
0
Réponse 2 / 7
cs_PhilippeE Messages postés 437 Date d'inscription mercredi 18 décembre 2002 Statut Membre Dernière intervention 10 août 2010 2
8 juil. 2004 à 14:58
On parle d'objet en VB ... instruction Set obligatoire 

xlBook.Close(False)
Set xlSheet =  Nothing
 Set  xlBook = Nothing
xlApp.Quit()
Set xlApp = Nothing
0
Réponse 3 / 7
cs_PhilippeE Messages postés 437 Date d'inscription mercredi 18 décembre 2002 Statut Membre Dernière intervention 10 août 2010 2
8 juil. 2004 à 15:00
J'ai oublié de dire ... 
xlBook.Close False

va fermer ton classeur actif sans le sauvegarder.
0
Réponse 4 / 7
alebib Messages postés 10 Date d'inscription mercredi 3 mars 2004 Statut Membre Dernière intervention 28 juillet 2005
8 juil. 2004 à 15:29
J'ai fait cele mais rien ne fonctionne.

Il y a encore une instance de Excel en mémoire.
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 7
alebib Messages postés 10 Date d'inscription mercredi 3 mars 2004 Statut Membre Dernière intervention 28 juillet 2005
8 juil. 2004 à 15:41
Je dois dire également que ma procédure charge plusieurs document excel à la fois. Le tout dans une boucle.
0
Réponse 6 / 7
alebib Messages postés 10 Date d'inscription mercredi 3 mars 2004 Statut Membre Dernière intervention 28 juillet 2005
8 juil. 2004 à 15:47
Voici mon code 

Public Sub Recuperation_balayages_fiches()
On Error GoTo GestionErreur

    'Déclaration des variables.
    Dim strSql As String
    Dim strSql2 As String
    Dim strSql3 As String
    Dim valeur As String
    Dim mont As String
    Dim feuille As String
    Dim col As Integer
    Dim lig As Integer
    Dim i As Integer
    Dim j As Integer
    Dim somme As Double
    Dim rsParam As recordset
    Dim rsFiche As recordset
    Dim rsCol As recordset
    Dim rsLig As recordset
    Dim rsDate As recordset
    Dim rsVerif As recordset
    Dim rsVentile As recordset
    Dim rsNoFiche As recordset
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    
    'Requête SQL pour aller chercher les infos sur les fiches.
    strSql = "SELECT * FROM [excel_parametre]"
    Set rsParam = CurrentDb.OpenRecordset(strSql)
    
    'Requête Sql pour savoir quelle fiche prendre.
    strSql = "SELECT * FROM [excel_fiche_extraction]"
    Set rsFiche = CurrentDb.OpenRecordset(strSql)
    
    'Requête SQL pour obtenir tout les colonnes à sélectionner.
    strSql = "SELECT * FROM [excel_colonne_definition]"
    Set rsCol = CurrentDb.OpenRecordset(strSql)
    
    'Requête SQL pour obtenir tout les lignes à sélectionner.
    strSql = "SELECT * FROM [excel_ligne_couts_capitalisables]"
    Set rsLig = CurrentDb.OpenRecordset(strSql)
    
    strSql = "SELECT Max(dat_extrc) AS Date_extrc FROM [dcrs_date_extraction]"
    Set rsDate = CurrentDb.OpenRecordset(strSql)
    
    'Créer un objet Excel.
    Set xlApp = CreateObject("Excel.Application")
  
    If (rsFiche.RecordCount <> 0) Then
        For j = 1 To 2 Step 1
            'Déterminé la bonne feuille pour l'importation des données.
            If (j = 1) Then
                feuille = rsParam!nom_feuil_recup_1
            Else
                feuille = rsParam!nom_feuil_recup_2
            End If
            
            rsFiche.MoveFirst
            
            Do Until rsFiche.EOF
                Set xlBook = xlApp.Workbooks.Open(rsParam!repert_fich_extrc & "" & rsFiche!fich_extrc)
                Set xlSheet = xlBook.Worksheets(feuille)
                xlSheet.Application.Visible = True
            
                'Aller au dernier et revenir au premier.
                'Corrige le Bug avec la propriété recordCount.
                rsLig.MoveLast
                rsLig.MoveFirst
            
                'Aller au dernier et revenir au premier.
                'Corrige le Bug avec la propriété recordCount.
                rsCol.MoveLast
                rsCol.MoveFirst
            
                'Pour chaques colonnes.
                For col = 1 To rsCol.RecordCount Step 1
                    'Pour chaques lignes.
                    For lig = 1 To rsLig.RecordCount Step 1
                        'Récupérer le montant de la case sur la feuille excel.
                        valeur = CStr(Worksheets(feuille).Range(rsCol!colon_excel & rsLig!ligne_excel))
                    
                        mont = ""
                                        
                        'Enlever la virgle et la remplacer par un point.
                        For i = 1 To Len(valeur) Step 1
                            If (Mid(valeur, i, 1) <> ",") Then
                                mont = mont & Mid(valeur, i, 1)
                            End If
                        Next i
                        
                        'Convertir en millier de dollars.
                        mont = Trim(Str(val(mont) * 1000))
                                                If Not (IsNull(valeur) Or valeur "" Or val(valeur) 0) Then
                            'Requête SQL pour vérifié.                            strSql2 "SELECT * FROM [excel_balayage_fiche] WHERE no_proj '" & rsFiche!no_proj & "' "                            strSql2 strSql2 & "AND ligne_excel '" & rsLig!ligne_excel & "' "                            strSql2 strSql2 & "AND colon_excel '" & rsCol!colon_excel & "' "                            strSql2 strSql2 & "AND month(dat_extrc) " & (Month(rsDate!date_extrc) - 1)
                            
                            'Extraire les données pour la vérfication.
                            Set rsVerif = CurrentDb.OpenRecordset(strSql2)
                            
                            'Requête SQL pour ajouter le contenu de la fiche.
                            strSql = "INSERT INTO [excel_balayage_fiche] (dat_extrc, an_fina, no_proj, ligne_excel, colon_excel, "
                            strSql = strSql & "cr, montant, no_autm_volet, no_autm_dep) "
                            strSql = strSql & "VALUES (#" & rsDate!date_extrc & "#, '" & Worksheets(feuille).Range(rsParam!posi_an_budg) & "', "
                            strSql = strSql & "'" & rsFiche!no_proj & "', '" & rsLig!ligne_excel & "', "
                            strSql = strSql & "'" & rsCol!colon_excel & "', '" & rsCol!cr & "', " & mont & ", 2"
                            strSql = strSql & ", " & rsLig!no_autm_dep & ")"
                            
                            'Si il n'y a pas d'enregistrement.
                            If (rsVerif.RecordCount = 0) Then
                                'Exécution la requête.
                                DoCmd.SetWarnings False
                                DoCmd.RunSQL strSql
                                DoCmd.SetWarnings True
                            'Si le montant vérifié est le même que sur la fiche (excel).
                            ElseIf (rsVerif!montant = mont) Then
                                'Exécution la requête.
                                DoCmd.SetWarnings False
                                DoCmd.RunSQL strSql
                                DoCmd.SetWarnings True
                            'Si le montant est différent de 0 et différent de la fiche (excel).
                            ElseIf (rsVerif!montant <> 0 And rsVerif!montant <> mont) Then
                                'Requête pour trouver les ventillations si le montant est différent de
                                'sur la fiche de projet.                                strSql2 "SELECT * FROM [excel_balayage_fiche_ventilé] WHERE no_autm_fiche "
                                strSql2 = strSql2 & rsVerif!no_autm_fiche
                                                                
                                'Initialisation.
                                somme = rsVerif!montant
                                
                                'Extraire la ventillation du montant.
                                Set rsVentile = CurrentDb.OpenRecordset(strSql2)
                                
                                If (rsVentile.RecordCount <> 0) Then
                                    Do Until rsVentile.EOF
                                        'Additionner les montants ventillés.
                                        somme = somme + rsVentile!montant
                                        rsVentile.MoveNext
                                    Loop
                                    
                                    rsVentile.MoveFirst
                                    
                                    If (somme = mont) Then
                                        'Requête SQL pour ajouter le contenu de la fiche.
                                        strSql = "INSERT INTO [excel_balayage_fiche] (dat_extrc, an_fina, no_proj, ligne_excel, colon_excel, "
                                        strSql = strSql & "cr, montant, no_autm_volet, no_autm_dep) "
                                        strSql = strSql & "VALUES (#" & rsDate!date_extrc & "#, '" & Worksheets(feuille).Range(rsParam!posi_an_budg) & "', "
                                        strSql = strSql & "'" & rsFiche!no_proj & "', '" & rsLig!ligne_excel & "', "
                                        strSql = strSql & "'" & rsCol!colon_excel & "', '" & rsCol!cr & "', " & rsVerif!montant & ", 2"
                                        strSql = strSql & ", " & rsLig!no_autm_dep & ")"
                                        
                                        'Exécution la requête.
                                        DoCmd.SetWarnings False
                                        DoCmd.RunSQL strSql
                                        DoCmd.SetWarnings True
                                        
                                        'Aller chercher le numéro de la fiche.
                                        Set rsNoFiche = CurrentDb.OpenRecordset("SELECT Max(no_autm_fiche) AS MaxNoFiche FROM excel_balayage_fiche")

                                        Do Until rsVentile.EOF
                                            'Requête SQL pour ajouter le contenu de la fiche ventillé.
                                            strSql3 = "INSERT INTO [excel_balayage_fiche_ventilé] (no_autm_fiche, "
                                            strSql3 = strSql3 & "cr, montant, no_autm_dep, comntr) "
                                            strSql3 = strSql3 & "VALUES (" & rsNoFiche!maxnofiche & ", "
                                            strSql3 = strSql3 & "'" & rsVentile!cr & "', " & rsVentile!montant & ", "
                                            strSql3 = strSql3 & rsVentile!no_autm_dep & ", "
                                            strSql3 = strSql3 & "'" & rsVentile!comntr & "')"

                                            'Exécution la requête.
                                            DoCmd.SetWarnings False
                                            DoCmd.RunSQL strSql3
                                            DoCmd.SetWarnings True
                                            
                                            rsVentile.MoveNext
                                        Loop
                                    Else
                                        'Requête SQL pour ajouter le contenu de la fiche.
                                        strSql = "INSERT INTO [excel_balayage_fiche] (dat_extrc, an_fina, no_proj, ligne_excel, colon_excel, "
                                        strSql = strSql & "cr, montant, no_autm_volet, no_autm_dep) "
                                        strSql = strSql & "VALUES (#" & rsDate!date_extrc & "#, '" & Worksheets(feuille).Range(rsParam!posi_an_budg) & "', "
                                        strSql = strSql & "'" & rsFiche!no_proj & "', '" & rsLig!ligne_excel & "', "
                                        strSql = strSql & "'" & rsCol!colon_excel & "', '" & rsCol!cr & "', " & mont & ", 2"
                                        strSql = strSql & ", " & rsLig!no_autm_dep & ")"
                                        
                                        'Exécution la requête.
                                        DoCmd.SetWarnings False
                                        DoCmd.RunSQL strSql
                                        DoCmd.SetWarnings True
                                    End If
                                End If
                            End If
                        End If
                    
                        rsLig.MoveNext
                    Next lig
                
                    'remettre les lignes au début.
                    rsLig.MoveFirst
                    rsCol.MoveNext
                Next col
            
                rsFiche.MoveNext
            Loop
        Next j
    End If
    
GestionErreur:
    'Capture des informations relatives à l'erreur.
    numeroErr = Err.Number
    messageErr = Err.Description
    retourErr = GestionErreur(numeroErr, messageErr)
    
SortieRoutine:
    'Si il n'y a pas d'erreur.
    If (numeroErr <> 0) Then
        DoCmd.SetWarnings False
        DoCmd.RunSQL "UPDATE [DCRS_erreur] SET erreur = true"
        DoCmd.SetWarnings True
    End If
    
    'Libérer les ressources.
    Set rsParam = Nothing
    Set rsFiche = Nothing
    Set rsCol = Nothing
    Set rsLig = Nothing
    Set rsDate = Nothing
    Set rsVerif = Nothing
    Set rsVentile = Nothing
    Set rsNoFiche = Nothing
    DoEvents
    
    xlBook.Close False
    Set xlSheet = Nothing
    Set xlBook = Nothing
    xlApp.Quit
    Set xlApp = Nothing
End Sub
0
Réponse 7 / 7
cs_PhilippeE Messages postés 437 Date d'inscription mercredi 18 décembre 2002 Statut Membre Dernière intervention 10 août 2010 2
8 juil. 2004 à 18:37
Tu as essayé de boucler pour fermer tous tes classeurs ? 

For Each xlBook in xlApp.Workbooks
xlBook.Close False
Next xlBook
0

Discussions similaires

Extraire une donnée d'une cellule excel avec python
pascal128 -
pascal128 -

3 réponses
EXCEL, faire l'inverse tangente atan pour avoir une valeur en degré minute
wind3813 -
wind3813 -

2 réponses
planning + suivi de maintenance
ranok -
ranok -

33 réponses
Calcul sur excel de l'inverse tangente en grade
HERTAN -
ucfoutu -

4 réponses
Les fonctions " racines niemmes " et " arctan "et "arccos " et "arcsin"
labriji -
labriji -

6 réponses
Rejoignez-nous