1. Ce site utilise des "témoins de connexion" (cookies) conformes aux textes de l'Union Européenne. Continuer à naviguer sur nos pages vaut acceptation de notre règlement en la matière. En savoir plus.

XL 2016 RESOLU. VBA aide adaptation code VBA de rechercher d’erreurs dans une feuille

Discussion dans 'Forum Excel' démarrée par richard31, 10 Août 2018.

  1. Dranreb

    Dranreb XLDnaute Barbatruc

    Inscrit depuis le :
    31 Janvier 2011
    Messages :
    14635
    "J'aime" reçus :
    887
    Sexe :
    Masculin
    Habite à:
    Belfort
    Utilise:
    Excel 2016 (PC)
    Essayez comme ça :
    Code (Visual Basic):
    Sub AfficherUF_Erreur()
       Dim Wsh As Worksheet, Cel As Range, RngUR As Range, Adr As String
       For Each Wsh In ActiveWorkbook.Worksheets
          On Error Resume Next
          Set RngUR = Wsh.UsedRange
          AjoutLbxErr RngUR.SpecialCells(xlCellTypeConstants, xlErrors), Wsh.Name
          AjoutLbxErr RngUR.SpecialCells(xlCellTypeFormulas, xlErrors), Wsh.Name
          Err.Clear
          Set Cel = RngUR.Find(What:="#REF!", LookIn:=xlFormulas, LookAt:=xlPart, _
             SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
          If Err Then Set Cel = Nothing
          On Error GoTo 0
          If Not Cel Is Nothing Then
             Adr = Cel.Address
             Do: UF_Erreurs.ListBoxErreurs.AddItem Cel.Text
                UF_Erreurs.ListBoxErreurs.List(UF_Erreurs.ListBoxErreurs.ListCount - 1, 1) = Wsh.Name
                UF_Erreurs.ListBoxErreurs.List(UF_Erreurs.ListBoxErreurs.ListCount - 1, 2) = Cel.Address(False, False)
                UF_Erreurs.ListBoxErreurs.List(UF_Erreurs.ListBoxErreurs.ListCount - 1, 3) = Cel.FormulaLocal
                Set Cel = RngUR.FindNext: Loop Until Cel.Address = Adr
             End If
          Next Wsh
       If UF_Erreurs.ListBoxErreurs.ListCount = 0 Then
          MsgBox "Aucune cellule en erreur trouvée dans ce classeur", vbInformation, "Voir les erreurs"
       Else: UF_Erreurs.Show 0: End If
       End Sub
    Private Sub AjoutLbxErr(ByVal RngErr As Range, ByVal NomFeuil As String)
       Dim Cel As Range
       For Each Cel In RngErr
          UF_Erreurs.ListBoxErreurs.AddItem Choose((CLng(Cel.Value) - 1993) \ 7, _
             "#NUL!", "#DIV/0!", "#VALEUR!", "#REF!", "#NOM?", "#NOMBRE!", "#N/A")
              UF_Erreurs.ListBoxErreurs.List(UF_Erreurs.ListBoxErreurs.ListCount - 1, 1) = NomFeuil
              UF_Erreurs.ListBoxErreurs.List(UF_Erreurs.ListBoxErreurs.ListCount - 1, 2) = Cel.Address(False, False)
              UF_Erreurs.ListBoxErreurs.List(UF_Erreurs.ListBoxErreurs.ListCount - 1, 3) = Cel.FormulaLocal
          Next Cel
       End Sub
     
     
Chargement...
Discussions similaires - VBA aide adaptation Forum Date
Aide sur adaptation de code VBA ?? Forum Excel 17 Novembre 2006
XL 2013 aide vba svp Forum Excel 4 Décembre 2018
XL 2016 Aide & Optimisation VBA...base de donnée Forum Excel 26 Novembre 2018
XL 2010 Problème de boucles VBA demande aide pour correction Forum Excel 15 Novembre 2018
XL 2010 Aide vba Forum Excel 18 Juillet 2018

Partager cette page