Plantage fichier analyse des codes VBA

Bonsoir à tous,

J'ai créer un module avec au début ces lignes :

Sub UtilisationInstructionResume()
    Dim i As Integer, j As Integer

    On Error GoTo ErrorHandler

    'Par défaut i=0 (et va provoquer une erreur)
    j = 5 / i
    MsgBox j

J'ai, pour chaque code présent dans les modules 1 et 2, placé la procédure en dessous et j'ai mis ce code à la fin :

    Exit Sub

ErrorHandler:
    MsgBox "Erreur: " & Err.Number & vbCrLf & Err.Description
    If i = 0 Then i = 1
    'Reprend l'exécution au niveau de la ligne à l'origine de l'erreur.
    Resume

End Sub

Une fois en place, à tour de role j'ai lancé le bouton associé aux macros, et je n'ai eu qu'un seul message d'eerur mais qui est volontaire je pense avec le code placé au début :

'Par défaut i=0 (et va provoquer une erreur)

Erreur 11 Divison par 0 , puis un MsgBox indiqué 5,

Hormis ça, les macros se sont déroulées sans problème, peut être que j'ai mal procéder au test de celles ci?,

Le problème se situerai par déduction sur mes codes présent dans ThisWoorkook?,

Il y a une procédure qui permet de laisser que le premier onglet de chaque couleur visible :

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
' la sélection d'un onglet en couleur rend visible
' tous les onglets même couleur.
' Les autres sont masqués sauf le 1er de chaque groupe en couleur.
'
' Les onglets xlSheetVeryHidden ou sans couleur restent inchangés.
'
'
    Dim coul As Long
    Dim sh2 As Worksheet

    coul = Sh.Tab.Color
    For Each sh2 In Worksheets
        If sh2.Index > 1 And Not (sh2.Visible = xlSheetVeryHidden Or sh2.Tab.Color = 0) Then
            If sh2.Tab.Color = coul Then
                sh2.Visible = xlSheetVisible
            Else
                sh2.Visible = sh2.Tab.Color <> Sheets(sh2.Index - 1).Tab.Color
            End If
        End If
    Next sh2
End Sub

et une deuxième procédure qui permet sur n'importe quels onglets du fichier d'accéder aux liens hypertextes créés vers les onglets masqués :

Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
    Dim lienSplit() As String
    Dim Feuille As String

    Application.ScreenUpdating = False
    lienSplit = Split(Target.SubAddress, "!")
    If UBound(lienSplit) >= 1 Then
        Feuille = Replace(lienSplit(0), "'", "")
        With ThisWorkbook.Sheets(Feuille)
            If .Visible = False Then
                .Visible = True
                Application.GoTo .Range(lienSplit(1))
            End If
        End With
    Else
        MsgBox ("Lien non valide... " & Target.SubAddress)
    End If
End Sub

Peut e^tre que la remarque de Jean Eric est la source de mon problème :

"Re,
En effet, DrawingObjects (caché) existe encore pour la compatibilité descendante et depuis des lustres.
Regarde pour remplacer :

Sub XXX()
Dim ws As Worksheet
Dim shpName As String, shptext As String

    Set ws = Feuil1
    shpName = Application.Caller
    shptext = ws.Shapes.Range(shpName).TextFrame2.TextRange.Text

    MsgBox shpName
    MsgBox shptext  'Classe

End Sub

Mais je ne serais pas le changer sur la macro présente dans mon fichier,

j'attends également le retour de Jean Paul relatif au "Pour le Set ... quand tu fait une assignation tu dois vérifier que tout c'est bien passé, si le tableau n'existe plus, que le nom de celui-ci à changé ou autre ton Set te renverra un Object qui sera = à rien Nothing donc ce qui peut poser des problèmes."
Car je ne serai pas également comment mettre en place la procédure de vérification?,

Merci à tous pour votre aide,

Cordialement,

A nouveau,

Découpages du programme en portions.

Ajout d'un court module 3 pour suivre quelques erreurs.

Sub ErrListe(ErrType As String)
MsgBox "Erreur " & ErrType
End Sub

Ajout d'un fichier xlsx binôme (à créer dans le même répertoire que le fichier à tester) pour suivre le déroulement du programme(sauvegarde régulière) et nommé Contrôles.

Module 2, partie CSV est testé (aucun souci)

Sub ImportCSV()
'-----------------Par Bouton CSV feuille CSV, Module sans erreur, SORTIE CSV correct--------------
Dim X As String
'Première partie de programme
'--------------------------------------------------------------------------
X = "Partie1CSV": On Error GoTo ErrCSV 'Portion du code à traiter si Erreur
'--------------------------------------------------------------------------
Dim Tbl As Variant, TblTemp As Variant, FileNumber&, i&, j&, chemin$, T#

'Contrôle qu'il existe au moins une ligne
If ActiveSheet.Range("A2") = "" Then MsgBox "Cellule vide, Export impossible": Exit Sub

FileNumber = FreeFile

'Choix d'un chemin test
'chemin = ThisWorkbook.Path & "\" 'Fichier sur le même répertoire
'Ou particulier
chemin = "P:\APEI\5 BILAN\5 CSV IMPORT\" & Range("ANNEE") & "\"

chemin = chemin & "Import_" & Sheets("CSV").Cells(2, 1) & Format(Date, "_YYYY_MM_DD") & ".csv"

Tbl = Range("CSV_INITIAL_2").Value
'Fichier d'enregistrement du déroulement du programme
Workbooks("Contrôles.xlsx").Sheets("Erreurs").Range("A1") = "Partie1Csv_OK"
Workbooks("Contrôles.xlsx").Save
'Deuxième partie de programme
'-----------------------------------------------------------------------
X = "Partie2CSV": On Error GoTo ErrCSV
'------------------------------------------------------------------------
ReDim TblTemp(LBound(Tbl, 2) To UBound(Tbl, 2))

Open chemin For Output As #FileNumber

For i = LBound(Tbl, 1) To UBound(Tbl, 1)
    For j = LBound(Tbl, 2) To UBound(Tbl, 2)
        TblTemp(j) = Tbl(i, j)
    Next j
    Print #FileNumber, Join(TblTemp, ";")
Next i

Close #FileNumber
'Fichier d'enregistrement du déroulement du programme
Workbooks("Contrôles.xlsx").Sheets("Erreurs").Range("A2") = "Partie2Csv_OK"
Workbooks("Contrôles.xlsx").Save
Exit Sub
ErrCSV:
'Module 3 = Listing des Erreurs selon portion de code
Call ErrListe(X)
End Sub

Module 1 Creer_Fichier_Classes (testé les 2ières portions). OK

Possible de changer DrawingObjets pour être plus actuel mais fonctionnement correct.

Sub Creer_Fichiers_Classes()
Dim X As String, F As Worksheet, classe$, P As Range, i As Variant, s, chemin$, c As Range, w As Worksheet, o As Object, nom As Name, sup As Boolean
'-------------------------------------------------------------------------------------
X = "Partie1Classe": On Error GoTo ErrClasse 'Portion du code à traiter si Erreur
'-------------------------------------------------------------------------------------
'---préparation---
Set F = Feuil1 'CodeName
classe = F.DrawingObjects(Application.Caller).Text 'les boutons doivent avoir des noms différents
Set P = F.ListObjects(1).Range 'tableau structuré
i = Application.Match(classe, P.Columns(3), 0) 'EQUIV

If IsError(i) Then MsgBox classe & " non trouvée !", 48: Exit Sub
'Colonne A
Set P = P(i, 1).Resize(Application.CountIf(P.Columns(3), classe), P.Columns.Count)

'Nbre  de lignes Ok
If Application.CountIf(P.Columns(5), "OK") <> P.Rows.Count Then Stop: MsgBox "Il faut que tous les onglets de " & classe & " soient validés par OK...": Exit Sub
'Fichier d'enregistrement du déroulement du programme
Workbooks("Contrôles.xlsx").Sheets("Erreurs").Range("B1") = "Partie1Classe_OK"
Workbooks("Contrôles.xlsx").Save
'---création des dossiers s'ils n'existent pas---
'-------------------------------------------------------------------------------------
X = "Partie2Classe": On Error GoTo ErrClasse 'Portion du code à traiter si Erreur
'-------------------------------------------------------------------------------------
s = Split(P(1, 4), "\") 'Colonne D Masquée
chemin = s(0) & "\" 'lecteur
For i = 1 To UBound(s)
    chemin = chemin & s(i) & "\"
    If Dir(chemin, vbDirectory) = "" Then MkDir chemin
Next i
'---création des fichiers---
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si un fichier a déjà été créé
For Each c In P.Columns(1).Cells
    Set w = ThisWorkbook.Sheets(CStr(c))
    w.Visible = xlSheetVisible 'si la feuille est masquée
    Application.EnableEvents = False 'désactive les évènements
    If c(1, 2) <> c(0, 2) Then 'compare avec le nom de fichier au-dessus
        w.Copy 'crée un nouveau document
    Else
        w.Copy After:=ActiveSheet 'ajoute la feuille copiée
    End If

'Fichier d'enregistrement du déroulement du programme
Workbooks("Contrôles.xlsx").Sheets("Erreurs").Range("B2") = "Partie2Classe_OK"
Workbooks("Contrôles.xlsx").Save
'-------------------------------------------------------------------------------------
X = "Partie3Classe": On Error GoTo ErrClasse 'Portion du code à traiter si Erreur
'-------------------------------------------------------------------------------------
    Application.EnableEvents = True 'réactive les évènements
    For Each o In ActiveSheet.PivotTables 'TCD
        With o.TableRange2
            s = .Value 'mémorise les valeurs
            .ClearContents 'efface le TCD
            .Value = s 'restitue les valeurs
        End With
    Next o

    Set o = Nothing 'Déchargement de l'objet

    For Each o In ActiveSheet.ListObjects 'tableaux structurés
        o.Unlist 'convertit en plage
    Next o

    Set o = Nothing

    For Each o In ActiveWorkbook.Connections 'Suppression des connections requêtes
        o.Delete
    Next o

    Set o = Nothing

    Range(w.UsedRange.Address) = w.UsedRange.Value 'supprime les formules
    Cells.Hyperlinks.Delete 'supprime les liens hypertextes
    Cells.Validation.Delete 'supprime les liens des listes de données

'Fichier d'enregistrement du déroulement du programme
Workbooks("Contrôles.xlsx").Sheets("Erreurs").Range("B3") = "Partie3Classe_OK"
Workbooks("Contrôles.xlsx").Save
'-------------------------------------------------------------------------------------
X = "Partie4Classe": On Error GoTo ErrClasse 'Portion du code à traiter si Erreur
'-------------------------------------------------------------------------------------
    If c(1, 2) <> c(2, 2) Then 'compare avec le nom de fichier au-dessous

On Error Resume Next

 For Each nom In ActiveWorkbook.Names
      If PréfixeFeuille(nom.Name) <> PréfixeFeuille(Mid$(nom.RefersTo, 2)) Then nom.Delete
 Next nom

 On Error GoTo 0

        Sheets(1).Select '1ère feuille
        ActiveWorkbook.SaveAs chemin & c(1, 2), 51 'enregistre avec l'extension .xlsx
        ActiveWorkbook.Close False 'ferme le document
    End If
Next c
'Fichier d'enregistrement du déroulement du programme
Workbooks("Contrôles.xlsx").Sheets("Erreurs").Range("B4") = "Partie4Classe_OK"
Workbooks("Contrôles.xlsx").Save
Exit Sub
ErrClasse:
'Module 3 = Listing des Erreurs selon portion de code
Call ErrListe(X)
End Sub

Plus quelques lignes.

Il y a une procédure qui permet de laisser que le premier onglet de chaque couleur visible :

Cette procédure couleur est fonctionnelle (Déploiement et rabat des onglets)

Partie 3 sur les connexions non testés, ni partie 4.

Donc si plantage (ce programme en plus étant pas trop long). Ouvrir ensuite le fichier binôme Contrôles et vérifier les jalons posés en colonne A et B.

Bons tests avec le fichier originel.

supprimé, mauvaise lecture
eric

Bonjour Xcellus,

Tout d'abord pour votre retour,

J'ai tenté de voir comment vous aviez testé les portions de code et je dois loupé une étape car cela ne fonctionne pas !

J'ai créé un nouveau fichier Excel Xlsx nommé Contrôles dans le même répertoire que le fichier de travail,

Sur le fichier de travail je créer un module 3 avec ce code :

Sub ErrListe(ErrType As String)
MsgBox "Erreur " & ErrType
End Sub

J'ai dupliqué votre code à la place de la macro Import CSV:

Sub ImportCSV()
'-----------------Par Bouton CSV feuille CSV, Module sans erreur, SORTIE CSV correct--------------
Dim X As String
'Première partie de programme
'--------------------------------------------------------------------------
X = "Partie1CSV": On Error GoTo ErrCSV 'Portion du code à traiter si Erreur
'--------------------------------------------------------------------------
Dim Tbl As Variant, TblTemp As Variant, FileNumber&, i&, j&, chemin$, T#

'Contrôle qu'il existe au moins une ligne
If ActiveSheet.Range("A2") = "" Then MsgBox "Cellule vide, Export impossible": Exit Sub

FileNumber = FreeFile

'Choix d'un chemin test
'chemin = ThisWorkbook.Path & "\" 'Fichier sur le même répertoire
'Ou particulier
chemin = "P:\APEI\5 BILAN\5 CSV IMPORT\" & Range("ANNEE") & "\"

chemin = chemin & "Import_" & Sheets("CSV").Cells(2, 1) & Format(Date, "_YYYY_MM_DD") & ".csv"

Tbl = Range("CSV_INITIAL_2").Value
'Fichier d'enregistrement du déroulement du programme
Workbooks("Contrôles.xlsx").Sheets("Erreurs").Range("A1") = "Partie1Csv_OK"
Workbooks("Contrôles.xlsx").Save
'Deuxième partie de programme
'-----------------------------------------------------------------------
X = "Partie2CSV": On Error GoTo ErrCSV
'------------------------------------------------------------------------
ReDim TblTemp(LBound(Tbl, 2) To UBound(Tbl, 2))

Open chemin For Output As #FileNumber

For i = LBound(Tbl, 1) To UBound(Tbl, 1)
    For j = LBound(Tbl, 2) To UBound(Tbl, 2)
        TblTemp(j) = Tbl(i, j)
    Next j
    Print #FileNumber, Join(TblTemp, ";")
Next i

Close #FileNumber
'Fichier d'enregistrement du déroulement du programme
Workbooks("Contrôles.xlsx").Sheets("Erreurs").Range("A2") = "Partie2Csv_OK"
Workbooks("Contrôles.xlsx").Save
Exit Sub
ErrCSV:
'Module 3 = Listing des Erreurs selon portion de code
Call ErrListe(X)
End Sub

Mais lorsque je lance la macro , il me met un msg box avec indiqué "Erreur Partie1CSV" ?,

Qu'est ce que j'ai loupé car vous l'avez testé de votre coté avec réussite,

Merci d'avance,

Cordialement,

eriiic a écrit :

supprimé, mauvaise lecture
eric

Bonjour Eric,

Que vouliez vous dire?,

Cordialement,

eriiic a écrit :

supprimé, mauvaise lecture
eric

Bonjour Eric,

Que vouliez vous dire?,

Cordialement,

Bonjour,

J'ai peu de temps à cette heure. Pause café.

De mon phone, as tu ouvert le fichier Contrôles.?

Il doit être ouvert avec le fichier à tester.

Mon test sur répertoire cible pour le fichier csv est bien passé. J'ai eu quelques lignes débit & crédit.

Note que si envoie en erreur, c'est soit que fichier Contrôles non ouvert. A vérifier pour voir ce qu'il contient. Ne pas oublier de faire Raz de ce fichier En colonne À et B pour tester à nouveau le fichier principal.

Bonjour X Cellus,

Merci pour votre retour, pas de soucis je comprends que vous soyez occupé ;)

Alors effectivement je n'avais pas ouvert le fichier Contrôles lors du lancement de la macro, mais même ouvert et vide, lorsque je lance la procédure Import CSV, j'ai ce message : "Erreur Partie1CSV"

Comme je souhaite tester de votre façon les portions 3 et 4, je dois loupé quelque chose?,

Qu'entendez vous par fichier binôme?, j'ai juste créer un fichier vide Xlsx vide, et renommé Contrôles,

Merci d'avance,

Cordialement,

Bonjour,

Que vouliez vous dire?,

quand j'ai ouvert le fil j'ai cru lire un post où tu demandais le fonctionnement de ce que je t'avais proposé.
J'ai expliqué mais ensuite en remontant le fil je n'ai plus vu le tien. Ca devait être un post plus ancien et plus d'actualité.
J'ai donc supprimé.
eric

Bonjour Eric,

oui je demandais comment mettre en place la vérif d'erreur avec Resume, j'ai tenté mais je n'arrivais pas a mes fins,

X Cellus m'a apporter une solution que je n’arrive pas à mettre en œuvre mais ça doit être moi qui doit faire quelque chose qui ne va pas,

Merci pour votre retour,

Cordialement,

Ah, je n'avais donc pas rêvé.

Rien de compliqué.
En cas d'erreur interceptée tu es emmené sur le Stop.
Là, un simple F8 t'emmène en pas à pas sur la ligne avec l'erreur (grâce au Resume sans paramètre), dans le contexte de l'erreur (si tu refais F8 tu auras à nouveau l'erreur)
A ce moment tu as la ligne en cause pour l'analyser de plus près.
Tu peux aussi contrôler le contenu des variables ou mettre une expression dans les espions pour que vba t'évalue une partie de ta ligne, etc.
Il ne s'agit pas d'un traitement d'erreur à proprement parler. C'est une aide à supprimer une fois le débogage terminé.

Le saucissonnage d'un programme je le trouve plus intéressant quand aucune erreur n'est déclenchée, ça devient le seul moyen d'avancer.
En notant des points d'avancée du programme on peut arriver à déterminer la partie qui pose problème.
Quitte à redécouper plus finement si besoin...
eric

Bonsoir Eric,

Merci pour votre retour, est ce que ça correspond à cette mise en place dans la procédure :

"J'ai créer un module avec au début ces lignes :

Sub UtilisationInstructionResume()
    Dim i As Integer, j As Integer

    On Error GoTo ErrorHandler

    'Par défaut i=0 (et va provoquer une erreur)
    j = 5 / i
    MsgBox j

J'ai, pour chaque code présent dans les modules 1 et 2, placé la procédure en dessous et j'ai mis ce code à la fin :

 Exit Sub

ErrorHandler:
    MsgBox "Erreur: " & Err.Number & vbCrLf & Err.Description
    If i = 0 Then i = 1
    'Reprend l'exécution au niveau de la ligne à l'origine de l'erreur.
    Resume

End Sub

Une fois en place, à tour de rôle j'ai lancé le bouton associé aux macros, et je n'ai eu qu'un seul message d'erreur mais qui est volontaire je pense avec le code placé au début :

'Par défaut i=0 (et va provoquer une erreur)

Erreur 11 Divison par 0 , puis un MsgBox indiqué 5,"

Si oui, cela suppose alors que pour découvrir le problème de plantage de mon fichier (Excel ne peut ouvrir le programme ....) il faut que mon fichier beug, je ne peux pas vérifier avant ?, mais en cas de plantage je ne peux pas même pas ouvrir le fichier ou accéder au VBA ...

Qu'elle serait aussi la différence avec le mode débogage d'un code qui plante?,

Désolé de ne pas comprendre, j'avoue avoir du mal !

Cordialement,

Oui, c'est la même chose. Sauf que là il t'indique en plus le message d'erreur.
Tout ce qui est avec le i est là pour te montrer le fonctionnement, c'est à ôter.

J'ai un peu de mal à te suivre.
Quand ça plante ça fait quoi précisément ? Tout est bloqué et tu dois fermer sauvagement excel ?

Bonsoir Eric,

Alors quand j'ai eu que deux types de plantages aléatoires du fichier : le premier c'était "erreur système &h80004005 erreur non spécifié" : plus d'accés au VBA, plus de possibilité d'enregsiter le fichier ...

Après votre conseil d'ajouter ceci sur chaque module, je n'ai plus eu ce message :

On Error GoTo erreur
Exit Sub
erreur:
Stop: Resume
End Sub

mais il a planté de nouveau en me disant que le programme ne pouvait plus s'ouvrir, j'ai donc récupérer la sauvegarde de mon fichier (macro inscrite sur mon fichier d’origine permettant une sauvegarde à l'ouverture) j'ai eu ce message lors de la réparation de la sauvegarde: Fonction supprimée: Objet dans la partie /xl/workbook.xml (Classeur),

En fait, ce qui me pose problème c'est l’instabilité de mon fichier et je cherche absolument à savoir ce qui ne va pas, je suppose que c'est lié au code VBA dans les modules ou dans ThisWorkbook mais impossible de savoir d’où vient le problème,

Cordialement,

Bonsoir au forum et aux participants,

J'essaye de voir ce qui me poser ces problèmes aléatoires,

Pensez vous que ce serait peut être une piste si je vous dis que le fichier joint existe en 4 exemplaires sur mon réseau, et il m'arrive de les ouvrir en même temps, un conflit pourrait être générer ou est ce complètement ma remarque est stupide lol?,

Merci d'avance,

Cordialement,

A nouveau,

Je reprends le fil de cet après-midi. Pour te donner plus de renseignements.

Pour exemple le module CSV. Ou certains lignes de code sont découpées par portion.

Tu as au début du module la ligne X="Partie1CSV" qui est un jalon indiquant que l'on rentre dans la première portion.

Suivi de d'une ligne On ERROR Goto ErrCSV.

Ensuite avant la 2ème portion. Il y a un enregistrement sur le fichier Contrôles si aucune erreur n'est détectée. Donc la portion de programme est OK.

Sinon il ne pourrait y avoir d'enregistrement.

Et s'il y a eu une erreur dans cette 1ière portion (par On ERROR) alors on va directement sur un message d'erreur.

Ce qui permet sur plusieurs portions et surtout en cas de plantage de voir quelles portions se sont bien déroulées.

Vu que le fichier Contrôles est toujours sauvé si tout se passe bien

Donc là ou in n'enregistre pas la portion de programme. Il faut aller vérifier par débogage progressif (Outils espions) quelles variables posent souci.

Suite,

Voici d'ailleurs le fichier sous forme CSV enregistré hier lors du test.

Re,

je vous dis que le fichier joint existe en 4 exemplaires sur mon réseau

Ces 4 fichiers portent le même nom ou bien ont des différences?

Bonsoir X Cellus,

Merci pour votre retour, mais effectivement j'avais bien comprit que vous aviez découpé le code macro en deux portions, et qu'a la fin de chaque portion il y avait un enregistrement sur la feuille Contrôles,

J'ai pris mon fichier Forum, je ne modifie rien et je lance l’import CSV, le fichier CSV se créer bien là ou je le souhaite avec les informations du tableau "CSV intial2 " sans problème,

Le souci, c'est sauf erreur de ma part, lorsque je suis la démarche que vous m'avez envoyez afin de tester les portions :

1 : je créer un fichier vierge Xlsx que je nomme Contrôles, et qui est enregistré sur le même répertoire que mon fichier forum

2 : je colle entièrement votre code avec les deux portions sur le module 2 à la place de la macro Import CSV

3 : je créer sur le fichier forum un module 3 avec le petit code que vous avez écrit,

Mais lorsque je lance la macro Import CSV qui reprend votre code, il me met ce message d’erreur "Erreur Partie1CSV", il y a une chose que j'ai loupé?

Je vous rejoins les deux fichiers 'Forum" et "Contrôles", peut etre que vous verrez de suite ce qu'il ne va pas ?,

Merci d'avance,

Cordialement,

X Cellus a écrit :

Re,

je vous dis que le fichier joint existe en 4 exemplaires sur mon réseau

Ces 4 fichiers portent le même nom ou bien ont des différences?

Re bonsoir X Cellus,

Alors non les fichiers ont bien 4 nom différents, c'est du style "DOSSIER-NON DE L'ENTREPRISE-ANNEE",

Merci pour votre temps consacré à m'aider, c'est bien sympa de votre part !

Cordialement,