Manipulation Excel avec VB6

Signaler
Messages postés
3
Date d'inscription
vendredi 16 novembre 2007
Statut
Membre
Dernière intervention
21 novembre 2007
-
Messages postés
2065
Date d'inscription
lundi 11 avril 2005
Statut
Membre
Dernière intervention
14 mars 2016
-
Bonjour à tous,


Je suis débutant en VB6. J'ai créé une application sous VB6 qui simule un process industriel. Cette application utilise un classeur Excel (4 feuilles) pour présenter ses résultats.


Lorsque je fait tourner l'application sous VB6 (mode déboguage par exemple) tout se passe bien.


Lorsque je compile et que je fait tourner l'application, alors Excel se "plante" en cours d'écriture de mes résultats. Je doit fermer Excel et je retrouve dans mon application en message d'erreur dans la subroutine qui utilise Excel.
Ci-dessous un extrait de la procédure concernée :

Option Explicit
Dim XlApp As excel.Application



Public Sub Ecriture_Excel()
  Boite_Dialogue.CancelError = True
  Dim Fichier_A_Ecrire As String
'  ....etc



On Error GoTo erreur




'lit le fichier résultat
  Boite_Dialogue.Flags = &H806&




'Lecture Nom du Fichier Résultat pour Ecriture Excel"
  Boite_Dialogue.DialogTitle = LoadResString(1150 + Langue)
  If Fichier_Ouvert_Court <> "" Then
    Boite_Dialogue.FileName = Left(Fichier_Ouvert_Court, Len(Fichier_Ouvert_Court) - 4) + ".res"
  End If
  Boite_Dialogue.Filter = LoadResString(1151 + Langue)
  Boite_Dialogue.ShowOpen
 
'gestion du bouton annuler
  If Err.Number = 32755 Then
    Exit Sub
  End If
 
  Nom_Fich = Boite_Dialogue.FileName
  Fichier_A_Ecrire = Boite_Dialogue.FileTitle
  X = Right(Nom_Fich, 4)
  If Nom_Fich = "" Then
    Exit Sub
  ElseIf (X <> ".res") Then
    msg = MsgBox(LoadResString(780 + Langue), 64, LoadResString(211 + Langue))
    Exit Sub
  End If



  Nom_Fich = Boite_Dialogue.FileName
'Lecture du Fichier Résultat pour Ecriture Excel
  Call Lecture_Res(Nom_Fich)




'ouvre l'application Excel
  Set XlApp = CreateObject("Excel.Application")
  XlApp.Application.Visible = True
'affectation du nom de fichier
  X = Chemin_App + LoadResString(1152 + Langue)
'ouverture du fichier type
  XlApp.Application.Workbooks.Open (X)
 




'==========================================
'Ecriture du texte dans la feuille - page 1
'==========================================
  With XlApp.ActiveWorkbook.Worksheets("page 1")
    .Activate
    .Range("C2").Value = NomProj
    valeur = Tu
    .Range("E5").Value = valeur
'    .... etc



  End With




'Retour activation page 1 avant enregistrement
  XlApp.ActiveWorkbook.Worksheets("page 1").Activate



  XlApp.Application.Visible = False




'Enregistre la feuille
  Boite_Dialogue.Flags = &H806&
  Boite_Dialogue.DialogTitle = LoadResString(1173 + Langue)
  Boite_Dialogue.FileName = Left(Fichier_A_Ecrire, Len(Fichier_A_Ecrire) - 4)
  Boite_Dialogue.Filter = LoadResString(1174 + Langue)
  Boite_Dialogue.ShowSave
 
'gestion du bouton annuler
  If Err.Number = 32755 Then
    Exit Sub
  End If
 
  Nom_Fich = Boite_Dialogue.FileName
  If Nom_Fich = "" Then Exit Sub
  XlApp.ActiveSheet.SaveAs Nom_Fich
 
 
'fermeture application Excel
  XlApp.Quit
  Set XlApp = Nothing
 
GoTo suite
erreur:
  If Err.Number = 32755 Then
    Boite_Dialogue.CancelError = False
    Exit Sub
  Else
    msg = MsgBox("Une erreur s'est produite lors de l'écriture sous Excel", 64, LoadResString(211 + Langue))
  End If
suite:



End Sub




Est-ce que quelqu'un aurait une idée sur les causes de ce problème.
merci d'avance

Gege5908

3 réponses

Messages postés
2065
Date d'inscription
lundi 11 avril 2005
Statut
Membre
Dernière intervention
14 mars 2016
8
Non, je n'ai pas d'idée sûre comme ça... enfin, jsute une intuition (car la difficulté c'est tout même de repérer la ligne mettant excel en défaut) ... si tu laisse Excel Visible (à true) qu'est-ce que cela donne ? Car je sais qu'il arrive que certaines instructions soit mal effectuée quand Visible est False.... en clair met la ligne "XlApp.Application.Visible = False " en remarque...

Amicalement,
Us.
Messages postés
3
Date d'inscription
vendredi 16 novembre 2007
Statut
Membre
Dernière intervention
21 novembre 2007

J'ai testé ta suggestion. Sans changement.
En fait l'instruction
"XlApp.Application.Visible = False "
se situe à la fin des opérations d'écriture dans la feuille, juste avant la sauvegarde et la cloture d'Excel.
Le programme se plante avant, et toujours à partir du fichier *.exe issu de la compilation. En éxécution sous environnement VB6 (test) ou en mode débogage il n'y a pas de plantage.
Je dois ajouter aussi que ce programme est déjà assez ancien (6 à 7 ans). Il avait toujours relativement bien fonctionné, à l'exception de quelques défauts de fermeture totale d'Excel. Et tout d'un coup, depuis quelques semaines il se plante (?). J'avoue que je ne comprend pas du tout ce qui se passe car il n'y a pas eu de modification d'écriture dans la zone où le programme apparemment se plante.
A tout hasard, au vu de l'aspect de la feuille excel au moment du plantage, voici les lignes de code où le plantage se produit :

'colonne de départ
    col = 5
'jus entrant type 1
    .Cells(11, col).Value = Val(Left(Apd(Circ_Je), 1))
    .Cells(12, col).Value = Trim(Apd(Circ_Je))
    .Cells(13, col).Value = Rel_Abs(Dbt(1, Circ_Je), Tu)
    .Cells(14, col).Value = Rel_Abs(Dbt(1, Circ_Je), Tu) * 1000 / Mass_Volum_Jus(Tpt(1, Circ_Je), Bxpr(1, Circ_Je))
    .Cells(15, col).Value = Bxpr(1, Circ_Je)
    .Cells(16, col).Value = Tpt(1, Circ_Je)     'dernière instruction éxécutée avant plantage

Le programme se plante entre ici

'jus entrant type 4
    For j = 1 To NbCirc
      If Ityprod(j) = 4 Then
        col = col + 1
        .Range("jus_entrant").Copy
        .Cells(10, col).Select
        .Paste
        .Cells(11, col).Value = Val(Left(Apd(j), 1))
        .Cells(12, col).Value = Trim(Apd(j))
        .Cells(13, col).Value = Rel_Abs(Dbt(1, j), Tu)
        .Cells(14, col).Value = Rel_Abs(Dbt(1, j), Tu) * 1000 / Mass_Volum_Jus(Tpt(1, j), Bxpr(1, j))
        .Cells(15, col).Value = Bxpr(1, j)
        .Cells(16, col).Value = Tpt(1, j)
      End If
    Next j
'jus sortant type 5
    For j = 1 To NbCirc
      If Ityprod(j) = 5 Then
        col = col + 1
        .Range("jus_sortant").Copy
        .Cells(10, col).Select
        .Paste
        .Cells(11, col).Value = Val(Left(Apd(j), 1))
        .Cells(12, col).Value = Trim(Apd(j))
        .Cells(13, col).Value = Rel_Abs(Dbt(1, j), Tu)
        .Cells(14, col).Value = Rel_Abs(Dbt(1, j), Tu) * 1000 / Mass_Volum_Jus(Tpt(1, j), Bxpr(1, j))
        .Cells(15, col).Value = Bxpr(1, j)
        .Cells(16, col).Value = Tpt(1, j)
      End If
    Next j

et ici

'jus sortant type 2
    col = col + 1
    .Range("jus_sortant").Copy
    .Cells(10, col).Select
    .Paste
    .Cells(11, col).Value = Val(Left(Apo(Circ_Js), 1))
    If Nbre_JS = 1 Then
      .Cells(12, col).Value = RTrim(Apo(Circ_Js))
    Else
     .Cells(12, col).Value = "> 1"
    End If
    .Cells(13, col).Value = Rel_Abs(Q_Final, Tu)
    .Cells(14, col).Value = Rel_Abs(Q_Final, Tu) * 1000 / Mass_Volum_Jus(T_Final, Bx_Final)
    .Cells(15, col).Value = Bx_Final
    .Cells(16, col).Value = T_Final

Merci de toute aide
Gege5908
Messages postés
2065
Date d'inscription
lundi 11 avril 2005
Statut
Membre
Dernière intervention
14 mars 2016
8
As-tu la possibilité de tester ton programme sur un autre ordinateur, car tel que tu décris les choses cela donne l'impression que le problème vient (en quelque sorte) d'ailleurs...

Bon courage,
Us.