Excel : macro pour detecter une erreur

Fermé
logan989 Messages postés 38 Date d'inscription mercredi 7 avril 2010 Statut Membre Dernière intervention 12 juin 2013 - Modifié par logan989 le 15/04/2010 à 16:29
Le Pingou Messages postés 12242 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 16 mars 2025 - 7 mai 2010 à 14:54
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.



A voir également:

11 réponses

Réponse 1 / 11
michel_m Messages postés 16602 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 313
16 avril 2010 à 13:19
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
logan989 Messages postés 38 Date d'inscription mercredi 7 avril 2010 Statut Membre Dernière intervention 12 juin 2013
16 avril 2010 à 13:57
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
Le Pingou Messages postés 12242 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 16 mars 2025 1 458
16 avril 2010 à 14:47
Merci michel_m, je considère comme résolu.
0
Réponse 2 / 11
Le Pingou Messages postés 12242 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 16 mars 2025 1 458
15 avril 2010 à 22:25
Bonjour,
Alors mettez une copie de votre macro pour voir ou intégrer une balise de position!
1
Réponse 3 / 11
logan989 Messages postés 38 Date d'inscription mercredi 7 avril 2010 Statut Membre Dernière intervention 12 juin 2013
16 avril 2010 à 09:43
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
Réponse 4 / 11
logan989 Messages postés 38 Date d'inscription mercredi 7 avril 2010 Statut Membre Dernière intervention 12 juin 2013
Modifié par logan989 le 16/04/2010 à 16:11
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

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

Posez votre question
Réponse 5 / 11
michel_m Messages postés 16602 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 313
16 avril 2010 à 18:46
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
logan989 Messages postés 38 Date d'inscription mercredi 7 avril 2010 Statut Membre Dernière intervention 12 juin 2013
Modifié par logan989 le 19/04/2010 à 11:41
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
michel_m Messages postés 16602 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 313
19 avril 2010 à 13:56
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
logan989 Messages postés 38 Date d'inscription mercredi 7 avril 2010 Statut Membre Dernière intervention 12 juin 2013
19 avril 2010 à 15:06
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
Réponse 6 / 11
Le Pingou Messages postés 12242 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 16 mars 2025 1 458
19 avril 2010 à 15:59
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
michel_m Messages postés 16602 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 313
19 avril 2010 à 16:51
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
logan989 Messages postés 38 Date d'inscription mercredi 7 avril 2010 Statut Membre Dernière intervention 12 juin 2013
19 avril 2010 à 17:12
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
michel_m Messages postés 16602 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 313
19 avril 2010 à 17:25
passe par message perso pour le pingou et moi
0
Le Pingou Messages postés 12242 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 16 mars 2025 1 458
19 avril 2010 à 17:33
Merci michel_m c'est OK pour moi.
0
logan989 Messages postés 38 Date d'inscription mercredi 7 avril 2010 Statut Membre Dernière intervention 12 juin 2013
22 avril 2010 à 08:46
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
Réponse 7 / 11
michel_m Messages postés 16602 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 313
22 avril 2010 à 15:42
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
logan989 Messages postés 38 Date d'inscription mercredi 7 avril 2010 Statut Membre Dernière intervention 12 juin 2013
22 avril 2010 à 15:52
ligne For cptr = 0 To cptr_e - 1 : Erreur d'execution '6' : dépassement de capacité
0
logan989 Messages postés 38 Date d'inscription mercredi 7 avril 2010 Statut Membre Dernière intervention 12 juin 2013
Modifié par logan989 le 22/04/2010 à 16:00
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
michel_m Messages postés 16602 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 313
22 avril 2010 à 17:22
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
logan989 Messages postés 38 Date d'inscription mercredi 7 avril 2010 Statut Membre Dernière intervention 12 juin 2013
23 avril 2010 à 08:41
Un coup de CD ?
0
Réponse 8 / 11
Le Pingou Messages postés 12242 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 16 mars 2025 1 458
22 avril 2010 à 19:35
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
Réponse 9 / 11
Le Pingou Messages postés 12242 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 16 mars 2025 1 458
22 avril 2010 à 21:11
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
logan989 Messages postés 38 Date d'inscription mercredi 7 avril 2010 Statut Membre Dernière intervention 12 juin 2013
23 avril 2010 à 08:35
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
Réponse 10 / 11
Le Pingou Messages postés 12242 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 16 mars 2025 1 458
Modifié par Le Pingou le 23/04/2010 à 15:38
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
michel_m Messages postés 16602 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 313
23 avril 2010 à 17:39
Bonjour,
effectivement, ta solution de copier sur un nouveau classeur pourrait apporter une solution;sinon...
Cordialement,
Michel
0
Le Pingou Messages postés 12242 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 16 mars 2025 1 458
23 avril 2010 à 21:55
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
logan989 Messages postés 38 Date d'inscription mercredi 7 avril 2010 Statut Membre Dernière intervention 12 juin 2013
26 avril 2010 à 14:06
Bonjour,
Je suis un peu sur-booké en ce moment mais je vous tiendrai informé.
Merci
0
logan989 Messages postés 38 Date d'inscription mercredi 7 avril 2010 Statut Membre Dernière intervention 12 juin 2013
Modifié par logan989 le 7/05/2010 à 13:16
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
michel_m Messages postés 16602 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 313
7 mai 2010 à 11:29
Bonjour,

Excuses moi, mais je n'ai plus cette appli en t^te !...
0
Réponse 11 / 11
Le Pingou Messages postés 12242 Date d'inscription mercredi 11 août 2004 Statut Contributeur Dernière intervention 16 mars 2025 1 458
Modifié par Le Pingou le 7/05/2010 à 14:55
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