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