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

Dranreb

XLDnaute Barbatruc
Essayez comme ça :
VB:
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
 

Discussions similaires


Haut Bas