Excel : macro pour detecter une erreur

logan989 Messages postés 39 Statut Membre -  
Le Pingou Messages postés 12276 Date d'inscription   Statut Contributeur Dernière intervention   -
Bonjour à tous,

Je lance un nouveau sujet aujourd'hui concernant une macro que je dois modifier (ou remplacer) : elle a pour but de me signaler une erreur type #ref, #Value, #Div/0 et de signaler aussi s'il traine une "," dans mon classeur.
Elle fonctionne parfaitement aujourd'hui mais comme mon classeur est du genre plutôt vaste, je dois à présent signaler la page, voir même la cellule si possible, qui est en défaut !
Si quelqu'un de la communauté cçm a par hasard déjà vu ou réalisé ce type d'opération je suis à votre écoute !
Je rappelle que je travail sous Excel 2003.

Bbye merci à vous.

11 réponses

Résumé de la discussion

Une macro Excel 2003 vise à signaler les erreurs #REF, #Value, #Div/0 et à détecter les virgules dans le classeur, tout en identifiant la feuille et la cellule en défaut. La meilleure réponse propose une macro qui écrit sur une feuille dédiée les adresses des erreurs et des virgules à compléter, en parcourant plusieurs onglets et plages. Le code vérifie chaque cellule et collecte les coordonnées (adresse) lorsque IsError est vrai ou lorsque le texte contient une virgule, puis stocke les résultats pour affichage. D'autres échanges évoquent l'ajout d'une balise de position, des questions de compatibilité avec XL2007 et l'envoi éventuel de fichiers via des services externes.

Bobot (l'IA à votre service)
  1. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
     
    Bonjour

    ci dessous macro simplifiée pour donner en feuille 3 les adresses des erreurs et virgules à compléter et/ou adapter par tes soins. ci joint maquette de travail 

    Dim Erreurs, Virgules
Dim cptr_e As Integer, cptr_v As Integer

Sub chercherlerreur()
Dim cptr As Byte
Dim onglets, plages
Dim onglet As String, plage As String


onglets = Array("devis elec", "questionnaire") 'à complèter
plages = Array("B2:B6", "A2:A6") 'a complèter

ReDim Erreurs(1, 0)
ReDim Virgules(1, 0)

For cptr = 0 To UBound(onglets)
    onglet = onglets(cptr)
    plage = plages(cptr)
    verifier onglet, plage
Next

With Sheets(3)
Application.ScreenUpdating = False
.Range("B2:F1000").Clear
.Range("B2").Resize(UBound(Erreurs) + 1, 2) = Application.Transpose(Erreurs)
.Range("E2").Resize(UBound(Virgules) + 1, 2) = Application.Transpose(Virgules)

End With
End Sub


Sub verifier(feuille, zone)
Dim cellule As Range

With Sheets(feuille)
For Each cellule In .Range(zone)
If IsError(cellule) Then
    Erreurs(0, cptr_e) = feuille
    Erreurs(1, cptr_e) = cellule.Address
    cptr_e = cptr_e + 1
    ReDim Preserve Erreurs(1, cptr_e)

End If

test = cellule.Address
If cellule.Text Like "*,*" Then
    Virgules(0, cptr_v) = feuille
    Virgules(1, cptr_v) = cellule.Address
    cptr_v = cptr_v + 1
    ReDim Preserve Virgules(1, cptr_v)

End If
Next
End With

End Sub


    demo
    https://www.cjoint.com/?eqnsVsUoNV
    2
    1. logan989 Messages postés 39 Statut Membre
       
      oh waaah!

      Pour moi qui suis débutant en la matière (première fois que j'approche de près ou de loin une macro) c'est impressionnant !
      Je n'ai pas encore saisi tous le principe de fonctionnement mais j'ai testé ta démo et ça marche super!

      Merci beaucoup
      0
    2. Le Pingou Messages postés 12276 Date d'inscription   Statut Contributeur Dernière intervention   1 478
       
      Merci michel_m, je considère comme résolu.
      0
  2. Le Pingou Messages postés 12276 Date d'inscription   Statut Contributeur Dernière intervention   1 478
     
    Bonjour,
    Alors mettez une copie de votre macro pour voir ou intégrer une balise de position!
    1
  3. logan989 Messages postés 39 Statut Membre
     
    Bonjour,

    Voici ladite macro :

    Public HeureExecution As Double
    Public NomClasseur As Variant

    Public flagouverture As Boolean, flagref As Boolean, flagvirgule As Boolean

    Public Sub ExecuterTimer()

    Dim toto As Variant

    NomClasseur = ThisWorkbook.Name
    '************** Vérification des valeurs de cellules

    a = 0
    b = 0

    '**** Vérif de certaines feuilles uniquement
    For Each c1 In Workbooks(NomClasseur).Worksheets("Devis ELEC").Range("A1:M80")
    If IsError(c1) Then
    a = a + 1
    End If
    If c1.Text Like "*,*" Then
    b = b + 1

    End If
    Next
    For Each c1 In Workbooks(NomClasseur).Worksheets("Questionnaire").Range("A1:I80")
    If IsError(c1) Then
    a = a + 1
    End If

    If c1.Text Like "*,*" Then
    b = b + 1
    End If
    Next
    For Each c1 In Workbooks(NomClasseur).Worksheets("Liste actionneur-Alimentation").Range("A1:BL200")
    If IsError(c1) Then
    a = a + 1
    End If
    If c1.Text Like "*,*" Then
    b = b + 1
    End If
    Next
    For Each c1 In Workbooks(NomClasseur).Worksheets("Liste instrumentation").Range("A1:R370")
    If IsError(c1) Then
    a = a + 1
    End If
    If c1.Text Like "*,*" Then
    b = b + 1
    End If
    Next
    For Each c1 In Workbooks(NomClasseur).Worksheets("Tertiaire").Range("A1:CT120")
    If IsError(c1) Then
    a = a + 1
    End If
    If c1.Text Like "*,*" Then
    b = b + 1
    End If
    Next
    For Each c1 In Workbooks(NomClasseur).Worksheets("armoires").Range("A1:I26")
    If IsError(c1) Then
    a = a + 1
    End If

    If c1.Text Like "*,*" Then
    b = b + 1
    End If
    Next
    For Each c1 In Workbooks(NomClasseur).Worksheets("Dimensionnement armoire(s)").Range("A1:M36")
    If IsError(c1) Then
    a = a + 1
    End If
    If c1.Text Like "*,*" Then

    b = b + 1
    End If
    Next
    For Each c1 In Workbooks(NomClasseur).Worksheets("Coût armoires et coffrets").Range("A1:J60")
    If IsError(c1) Then
    a = a + 1
    End If
    If c1.Text Like "*,*" Then
    b = b + 1
    End If
    Next
    For Each c1 In Workbooks(NomClasseur).Worksheets("Récapitulatif câbles").Range("A1:Y130")
    If IsError(c1) Then
    a = a + 1
    End If
    If c1.Text Like "*,*" Then
    b = b + 1
    End If
    Next
    For Each c1 In Workbooks(NomClasseur).Worksheets("Calcul du transformateur").Range("A1:Y130")
    If IsError(c1) Then
    a = a + 1
    End If
    If c1.Text Like "*,*" Then
    b = b + 1
    End If
    Next
    For Each c1 In Workbooks(NomClasseur).Worksheets("Refroidissement").Range("A1:Y400")
    If IsError(c1) Then
    a = a + 1
    End If
    If c1.Text Like "*,*" Then
    b = b + 1
    End If
    Next

    'MsgBox ("Nombre cellules en erreur:" & a & " Flag ref:" & flagref & " Flag ouv:" & flagouverture)

    If a > 0 And flagref = False Then
    ' Il y a un #ref, #Value, #Div/0 qui traine
    toto = MsgBox("Une ou plusieurs cellules sont en erreur dans le fichier!", vbCritical, ThisWorkbook.Name)

    flagref = True
    ElseIf a = 0 And flagref = True Then
    ' Tout est ok
    flagref = False
    toto = MsgBox("Plus d'erreur dans les cellules.", vbInformation)
    End If

    '*******************
    If b > 0 And flagvirgule = False Then
    ' Il y a une virgule qui traîne quelque part
    toto = MsgBox("Une ou plusieurs cellules contiennent le caractère virgule :',' Voir avec EAS.", vbCritical, ThisWorkbook.Name)

    flagvirgule = True
    ElseIf b = 0 And flagvirgule = True Then
    ' Tout est ok
    flagvirgule = False
    toto = MsgBox("Plus de virgule.", vbInformation)
    End If

    '******** Vérification du nombre de feuille ouvertes
    If Workbooks.Count > 1 And flagouverture = False Then
    toto = MsgBox("Plus d'un fichier ouvert dans la même instance d'Excel! Fermer les autres fichiers ouverts ou ouvrir la note de calcul Elec dans un nouvel Excel.", vbCritical, ThisWorkbook.Name)
    flagouverture = True

    ElseIf Workbooks.Count = 1 And flagouverture = True Then
    flagouverture = False

    End If

    If flagouverture Or flagref Or flagvirgule Then
    Workbooks(NomClasseur).Worksheets("Devis ELEC").Range("H69").Value = "ERREUR"
    Else
    Workbooks(NomClasseur).Worksheets("Devis ELEC").Range("H69").Value = ""
    End If

    HeureExecution = Now + TimeSerial(0, 5, 0)
    Application.OnTime HeureExecution, "ExecuterTimer", , True

    End Sub
    Public Sub StopTimer()

    Application.OnTime HeureExecution, "ExecuterTimer", , False

    End Sub

    J'espère que ça pourra vous aider.
    0
  4. logan989 Messages postés 39 Statut Membre
     
    Encore une question michel_m : pour ta macro, une erreur se produit souvent :

    Erreur d'execution '9' : l'indice n'appartient pas à la sélection

    La ligne 38 est surlignée quand je clique sur débogage : Erreurs(0, cptr_e) = feuille

    As-tu l'explication ?
    0

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

    Posez votre question
  6. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
     
    Re,

    effectivement, il y avait ce piège et d'autres dans lesquels je suis tombé (ça, je sais bien faire)
    ci joint le classeur modifié avec en petit supplément gratuit un splendide chronomètre à la milliseconde
    https://www.cjoint.com/?eqsRDTWUrE

    Mes bourdes?

    dans "chercherlerreur" 
    With Sheets(3)
    Application.ScreenUpdating = False
    .Range("B2:F1000").Clear
    .Range("B2").Resize(cptr_e, 2) = Application.Transpose(Erreurs)
    .Range("E2").Resize(cptr_v, 2) = Application.Transpose(Virgules)
End With
Set Erreurs = Nothing
Set Virgules = Nothing
cptr_e = 0
cptr_v = 0


    dans "vérifier" (la cellule en erreur empèche de tester la virgul: il faut employer un elseif==> sinon si)
    la virgule peur être dans du texte (t'avais bien vu le truc) mais aussi dans un nombre 

    For Each cellule In .Range(zone)
        If IsError(cellule) Then
            Erreurs(0, cptr_e) = feuille
            Erreurs(1, cptr_e) = cellule.Address
            cptr_e = cptr_e + 1
            ReDim Preserve Erreurs(1, cptr_e)
        ElseIf cellule Like "*,*" Or cellule Like "#,#" Then
            Virgules(0, cptr_v) = feuille
            Virgules(1, cptr_v) = cellule.Address
            cptr_v = cptr_v + 1
            ReDim Preserve Virgules(1, cptr_v)
        End If
    Next


    excuses moi pour ces c... (au choix) j'espère que ce coup ci ce sera OK

    tu dis (je serai en ballade ce samedi)

    0
    1. logan989 Messages postés 39 Statut Membre
       
      Bonjour,
      Décidemment, j'ai vraiment du mal...
      J'ai ajouté tes corrections et à présent j'ai une nouvelle erreur :
      "Erreur d'execution '1004' :
      Erreur définie par l'application ou par l'objet"
      la ligne surlignée est dans la partie chercherlerreur :
      .Range("E2").Resize(cptr_v, 2) = Application.Transpose(Virgules)
      Désolé de t'embêter encore...
      Je suis vraiment une bille là-dedans.
      Merci du temps que tu m'as déjà accordé.
      a+
      0
    2. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
       
      Bonjour,

      Je viens de réessayer, c'est ok chez moi
      l'erreur 1004 voudrait dire ici que les dimensions du tableau "virgules" (virgules: orthographe identique partout?) sont différentes de la plage resize

      dans la PJ j'ai modifié sheets(3) en "erratas" et renommer donc l'onglet ainsi
      https://www.cjoint.com/?etn3nDG6DC
      0
    3. logan989 Messages postés 39 Statut Membre
       
      Re..
      Je crois que Excel nuit gravement à ma santé mentale : je deviens fou !
      J'ai exactement un copier/coller de ta macro (module 1) sauf les tableaux "array" où j'ai ajouter mes pages et le nom de l'onglet qui est chez moi "Erreurs" au lieu de "erratas" chez toi.
      C'est vraiment toutes les différences entre nos 2 macros.
      Effectivement elle marche bien chez toi.
      Chez moi par contre, l'erreur 1004 décrite tout à l'heure est bien présente lors de l'exécution.
      Pour moi c'est vraiment incompréhensible.
      0
  7. Le Pingou Messages postés 12276 Date d'inscription   Statut Contributeur Dernière intervention   1 478
     
    Bonjour,
    Excusez-moi de cette petite intrusion, s'il vous est possible de mettre votre fichier qui fait probléme sur https://www.cjoint.com/ et poster le lien se serait plus simple de trouver la gentillesse ...
    0
    1. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
       
      Bonjour Jean-Pierre
      je venais pour dire la même chose :-)
      mais pour des questions de poids et de format, il vaudrait mieux le zipper (pas de .rar) sur
      http://cijoint.fr/
      plutôt que
      cjoint.com
      0
    2. logan989 Messages postés 39 Statut Membre
       
      Oui, je suis conscient qu'il serait plus simple de fonctionner de cette manière, si ce n'est que je suis en entreprise dans le cadre d'un stage et que cette dernière tient à la confidentialité de ce dossier...
      0
    3. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
       
      passe par message perso pour le pingou et moi
      0
    4. Le Pingou Messages postés 12276 Date d'inscription   Statut Contributeur Dernière intervention   1 478
       
      Merci michel_m c'est OK pour moi.
      0
    5. logan989 Messages postés 39 Statut Membre
       
      Bonjour,
      Je ne peux définitivement pas communiquer le fichier. Il représente l'aboutissement de longs mois de travail et je ne suis pas autorisé à le divulguer.
      Désolé.
      0
  8. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
     
    essayes comme ceci, peut-être que... 
    With Sheets("Erreurs")
    .Range("B2:F1000").Clear
   
    For cptr = 0 To cptr_e - 1
        .Cells(2 + cptr, 2) = Erreurs(0, cptr)
        .Cells(2 + cptr, 3) = Erreurs(1, cptr)
    Next
    For cptr = 0 To cptr_v - 1
        Cells(2 + cptr, 5) = Virgules(0, cptr)
        .Cells(2 + cptr, 6) = Virgules(1, cptr)
    Next
    .Activate
    Application.ScreenUpdating = False
End With
    0
    1. logan989 Messages postés 39 Statut Membre
       
      ligne For cptr = 0 To cptr_e - 1 : Erreur d'execution '6' : dépassement de capacité
      0
    2. logan989 Messages postés 39 Statut Membre
       
      je rève... Ta macro marche bien dans ton fichier. je l'ai copier/coller dans mon module et devine quoi ? Ca marche pas...
      je suis dépitié...
      Cette fois on a : erreur d'execution '1004' : Erreur définie par l'application ou par l'objet
      La ligne : .Range("B2").Resize(cptr_e, 2) = Application.Transpose(Erreurs)
      0
    3. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
       
      Cauchemar plutôt!

      demain je vais donner un coup de CD office pour voir, essaies la m^me chose de ton coté.

      C'est fou ce truc... ;-(
      0
    4. logan989 Messages postés 39 Statut Membre
       
      Un coup de CD ?
      0
  9. Le Pingou Messages postés 12276 Date d'inscription   Statut Contributeur Dernière intervention   1 478
     
    Bonjour logan989,
    En supposant que les diverses procédures se trouvent dans le module sur lequel vous coller la procédure de michel_m, est-il possible d'obtenir le contenu de votre module copier sur un document Word via un message privé !
    0
  10. Le Pingou Messages postés 12276 Date d'inscription   Statut Contributeur Dernière intervention   1 478
     
    Bonjour logan989,
    Vous avez copier/coller dans votre module la procédure de michel-m, cependant avez-vous aussi copier/coller les 2 déclarations au niveau du module ?
    Dim Erreurs, Virgules
    Dim cptr_e As Long, cptr_v As Long

    J'ai fait un essai et si (Dim cptr_ ....) manque, j'obtient le message: erreur d'execution '1004' : Erreur définie par l'application ou par l'objet
    0
    1. logan989 Messages postés 39 Statut Membre
       
      Bonjour à vous.
      Oui mon module est strictement identique. Il commence bien par :
      Dim Erreurs, Virgules
      Dim cptr_e As Long, cptr_v As Long
      0
  11. Le Pingou Messages postés 12276 Date d'inscription   Statut Contributeur Dernière intervention   1 478
     
    Bonjour,
    Je suppose qu'il y a un disfonctionnement au niveau du classeur; essayer de copier les feuilles du classeur vers un nouveau classeur sans oublier le/les module/s.
    Salutations.
    Le Pingou
    0
    1. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
       
      Bonjour,
      effectivement, ta solution de copier sur un nouveau classeur pourrait apporter une solution;sinon...
      Cordialement,
      Michel
      0
    2. Le Pingou Messages postés 12276 Date d'inscription   Statut Contributeur Dernière intervention   1 478
       
      Bonjour michel_m,
      Eh bien j'ai pensé à cette solution car je suppose qu'il y a eu beaucoup d'essai, d'erreur de code VBA et aussi ajout et suppression de code et dans se sens il serait souhaitable de repartir avec un classeur propre.
      Je l'ai déjà expérimenté plusieurs fois.
      Il n'y a plus qu'à attendre la réponse de logan989.
      Salutations.
      Le Pingou
      0
    3. logan989 Messages postés 39 Statut Membre
       
      Bonjour,
      Je suis un peu sur-booké en ce moment mais je vous tiendrai informé.
      Merci
      0
    4. logan989 Messages postés 39 Statut Membre
       
      Bonjour,
      J'ai copié toutes mes pages dans un fichier vièrge en les faisant glisser et en maintenant la touche Ctrl. Le souci c'est que je me retrouve avec des référence à mon ancien fichier dans toutes les cellules contenant une formule. Est-ce qu'il y a moyen de faire autrement ou dois-je corriger chaques cellules ?
      Bbye
      0
    5. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
       
      Bonjour,

      Excuses moi, mais je n'ai plus cette appli en t^te !...
      0
  12. Le Pingou Messages postés 12276 Date d'inscription   Statut Contributeur Dernière intervention   1 478
     
    Bonjour,
    C'est étonnant que vous avez des références à votre ancien fichier.

    En marge, vous pouvez mettre le fichier compresser en ZIP ou RAR sur https://www.cjoint.com/ ou http://cijoint.fr/ et poster le lien sur un MP via mon profil.
    Salutations.
    Le Pingou
    0