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 :
    14375
    "J'aime" reçus :
    870
    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 2010 Aide vba Forum Excel 18 Juillet 2018
Aide VBA Forum Excel 28 Juin 2018
aide création formule vba,blocage liste déroulante en cascade Forum Excel 20 Juin 2018
Petite aide concernant une macro vba Forum Excel 18 Juin 2018

Partager cette page