Mon code vba marche une fois sur deux!

flateur18 Messages postés 35 Date d'inscription   Statut Membre Dernière intervention   -  
Patrice33740 Messages postés 8561 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour chers amis programmeurs,

J'ai un souci concernant l'execution de mon programme vba.
Depuis vba access, j'ouvre un fichier Excel, j'effectue des modifications dessus, et je le lie avec ma base access. quand je souhaite faire la même manip une deuxième fois (avec le même fichier ou un fichier différent) l'application excel plante.

ça fait des mois que ca dure!!! j'ai vu dans plein de forums que je dois declarer chaque objet (excel application, workbook, worksheet) et que je dois le detruir à la fin, c'est ce que je fait mais ça ne marche toujours pas !!!

voilà mon code : (en gras où ca plante) 
Private Sub fichier1()
    
    On Error GoTo Error_
    Dim xlApp1 As Excel.Application
    Dim xlWb1 As Excel.Workbook
    Dim xlSh1 As Excel.Worksheet
    
If Text11 <> "" Then
        Set xlApp1 = CreateObject("Excel.Application")
        Set xlWb1 = xlApp1.Workbooks.Open(Text11)  'text11 contient le chemin
        Set xlSh1 = xlWb1.Sheets(1)   'une seule feuille dans le fichier
    
    With xlApp1
        .DisplayAlerts = False
        .Visible = True
        .ActiveWorkbook.Save
        .Calculation = xlAutomatic
        .MaxChange = 0.001
        .ActiveWorkbook.PrecisionAsDisplayed = False
        If .ActiveSheet.Range("A1") <> "PO+PN" Then GoTo AddPOPN 

AddPOPN:  ' Ajout du PO+PN
        .Columns("A").Select
        .ActiveSheet.Columns("A:A").Insert Shift:=xlToRight
        .Range("A1") = "PO+PN"
        .ActiveSheet.Range("A2").Select
        .ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[38],RC[9])"
        .Selection.AutoFill Destination:=xlSh1.Range("A2:A" & Range("A2").end(xlDown).Row), Type:=xlFillDefault        
        .Columns("A:A").Select
        .Selection.NumberFormat = "@"
        If .ActiveSheet.Range("A1") = "PO+PN" Then GoTo Type_
Exit Sub

    End With
End If
    'fermeture du processus excel, sauvegarde  et liberationdes objets
    Set xlSh1 = Nothing
    Set xlWb1 = Nothing
    xlApp1.Quit
    Set xlApp1 = Nothing
Exit Sub
    
End Sub

'======================================================

Private Sub fichier2()

    On Error GoTo Error_
    Dim xlApp2 As Excel.Application
    Dim xlWb2 As Excel.Workbook
    Dim xlSh2 As Excel.Worksheet
    
If Text21 <> "" Then
        Set xlApp2 = CreateObject("Excel.Application")
        Set xlWb2 = xlApp2.Workbooks.Open(Text21)
        Set xlSh2 = xlWb2.Sheets(1)

    With xlApp2
        .DisplayAlerts = False
        .Visible = True
        .ActiveWorkbook.Save
        .Calculation = xlAutomatic
        .MaxChange = 0.001
        .ActiveWorkbook.PrecisionAsDisplayed = False
        If .ActiveSheet.Range("A1") <> "PO+PN" Then GoTo AddPOPN 

AddPOPN: ' Ajout du PO+PN
        .Columns("A").Select
        .ActiveSheet.Columns("A:A").Insert Shift:=xlToRight
        .Range("A1") = "PO+PN"
        .ActiveSheet.Range("A2").Select
        .ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[38],RC[9])"
        .Selection.AutoFill Destination:=xlSh2.Range("A2:A" & Range("A2").end(xlDown).Row), Type:=xlFillDefault       
        .Columns("A:A").Select
        .Selection.NumberFormat = "@"
        .ActiveWorkbook.Save
Exit Sub


    End With
End If

    'fermeture du processus excel et liberationdes objets
    Set xlSh2 = Nothing
    Set xlWb2 = Nothing
    xlApp2.Quit
    Set xlApp2 = Nothing
   
End Sub


Merci pour votre aide
A voir également:

3 réponses

Réponse 1 / 3
Patrice33740 Messages postés 8561 Date d'inscription   Statut Membre Dernière intervention   1 780
 
Bonsoir,

Difficile de répondre, le code est incomplet !

Le Exit Sub situé avant le End With est probablement un résidu de tentative de débogage.

il manque les labels correspondant à :
On Error GoTo Error_
If .ActiveSheet.Range("A1") = "PO+PN" Then GoTo Type_

Il manque la gestion d'erreur

Il y a une erreur sur la ligne :
.Selection.AutoFill Destination:=xlSh1.Range("A2:A" & _
Range("A2").End(xlDown).Row), Type:=xlFillDefault

Remplacer par
.Selection.AutoFill Destination:=xlSh1.Range("A2:A" & _
xlSh1.Range("A2").End(xlDown).Row), Type:=xlFillDefault

J'espère que cela suffit à régler le problème

Patrice
3
Patrice33740 Messages postés 8561 Date d'inscription   Statut Membre Dernière intervention   1 780
 
PS :
.ActiveWorkbook.Save devrait se situer juste avant le End With
0
flateur18 Messages postés 35 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour Patrice, et merci pour ta réponse.

En effet, pour la gestion des erreurs, j'ai tronqué les label "Error_:" et "Type_" car trop longs, mais ils sont bien dans mon code d'origine.

Quand je met le "Exit Sub" après "End With", mon code plante quand je ne rentre pas dans le label "AddPOPN:".

J'ai trouvé une "astuce" pour fermer systématiquement et "physiquement" toute application Excel avant de la réutiliser à nouveau, car c'est là d'où vennait le problème, des"objets" restaient actifs malgré la fermeture du processus Excel et la liberation des objets qu'on a créé.

Pour ceux qui sont intéressés voici la fonction à mettre dans un module : 

Option Compare Database 

Public Function KillProcess(ByVal ProcessName As String) As Boolean 
On Error GoTo err 
    Dim svc As Object 
    Dim sQuery As String 
    Dim oproc 
    Set svc = GetObject("winmgmts:root\cimv2") 
    sQuery = "select * from win32_process where name='" & ProcessName & "'" 
    For Each oproc In svc.execquery(sQuery) 
        oproc.Terminate 
    Next 
    Set svc = Nothing 
err: 
Set svc = Nothing 
'MsgBox err.Description & " " & err.Number & " " & err.Source 
End Function


et dans le code VB, écrire avant le "End Sub" de chaque procédure qui appelle Excel : 

KillProcess "Excel.exe"


Ca permet de repartir "Proprement" en ouvrant une autre application Excel.
Chez moi ça marche bien.

===========================================================================
"Ce qu'il y a de plus difficile à apprécier et à comprendre, c'est ce qui ce passe sous nos yeux !!!"
0
Patrice33740 Messages postés 8561 Date d'inscription   Statut Membre Dernière intervention   1 780
 
Bonjour,

Ce code est intéressant pour éliminer un processus qui ne s'est pas fermé correctement..

Concernant le problème que tu avais évoqué, il est très probable que cela vienne d'une ou plusieurs erreurs dans ton code qui entrainent un plantage du processus et donc l'empêchent de se fermer normalement.
Ta solution est très radicale mais elle ne résout pas l'origine du problème, avec toutes les conséquences que cela peut avoir sur la confiance accordée à ton code.

Après avoir corrigé ton code, je l'ai exécuté des dizaines de fois sans jamais avoir le moindre problème.

Corrections à faire :
- référencer chaque range et column par rapport à l'objet WorkSheet (xlSh1) au lieu de l'objet Application (xlApp1)
- Traiter entièrement le If .ActiveSheet.Range("A1") <> "PO+PN" Then en ajoutant un Else et un End if de façon à ne passer par AddPOPN: (qui devient inutile) que lorsque c'est nécessaire.
- supprimer le Exit Sub qui empêche la destruction des variables instanciées.

Cordialement
Patrice
0
Réponse 2 / 3
Patrice33740 Messages postés 8561 Date d'inscription   Statut Membre Dernière intervention   1 780
 
re
0
Réponse 3 / 3
flateur18 Messages postés 35 Date d'inscription   Statut Membre Dernière intervention  
 
Cher Patrice,

J'ai fait exactement ce que tu m'a dit, donc de référencer tous les .columns, .rows et .cells à mon objet xlSh1, et cela marche parfaitement, le processus se termine sans probleme après l'execution de toutes les commandes, et permet au suivant de s'ouvrir proprement, c'est nikel, j'ai même oté ma fonction "killProcess" car j'ai maintenant confiance en mon code.

Merci infiniment, et à de nouvelles aventures,

Cordialement
Manu
0
Patrice33740 Messages postés 8561 Date d'inscription   Statut Membre Dernière intervention   1 780
 
Au plaisir de te retrouver sur ce forum

Patrice
0

Discussions similaires

Devinette
Boura10000 -
Utilisateur anonyme -

2 réponses