Empecher la sauvegarde du classeur si présence d'une MEFC (couleur orange)

Bonjour à tous et à toutes,
Je suis nouveau sur ce forum et si j'ai créé un compte c'est car je ne trouve la solution nul part ailleurs :(
Donc voilà mon pb: Il se trouve que je souhaite créer une macro qui empêche l'enregistrement du classeur (avec plusieurs feuilles) si elle détecte la présence d'une MEFC (mise en forme conditionnelle) en orange sur une cellule dans une des feuilles.
Actuellement ma macro empêche l'enregistrement du classeur si elle détecte une MEFC en orange sur la feuille où je suis, mais si je possède une MEFC dans une autre feuille alors ma macro ne la prend pas en compte et enregistre tout de même le classeur.

Merci pour votre réponse.
Je vous laisse mon code qui fait ce que j'ai décris précédemment, si vous en avez un autre plus simple je suis preneur :)

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
     Application.ScreenUpdating = False
     Dim rngCondFormat As Range
     Dim rng As Range

     On Error Resume Next
     Set rngCondFormat = ActiveSheet.UsedRange.SpecialCells(xlCellTypeAllFormatConditions)

     On Error GoTo 0

     If Not rngCondFormat Is Nothing Then 
        For Each rng In rngCondFormat
            'DisplayFormat vérifie la couleur.
            If rng.DisplayFormat.Interior.ColorIndex = 46 Then
                MsgBox ("Vous devez remplir correctement les cellules en orange: ici " & rng.Address(0, 0))
                Cancel = True
                Application.ScreenUpdating = True
                Exit Sub
            End If
        Next rng
    End If
    Application.ScreenUpdating = True
 End Sub

Bonjour Louis26 et

Une petite présentation ICI serait la bienvenue

Si vous ne l'avez pas encore fait, je vous invite à lire la charte du forum [A LIRE AVANT DE POSTER]
qui vous aidera dans vos demandes et réponses sur ce forum

Ainsi que sur les fonctionnalités (Nouveau Forum au bas de page notamment)

Pour ce qui est de votre demande, voici un code

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  Dim Sht As Worksheet
  Dim Plage As Range, Rng As Range
  ' Pour chaque feuille du classeur
  For Each Sht In ThisWorkbook.Sheets
    ' Définir la plage utilisée
    Set Plage = Sht.UsedRange.SpecialCells(xlCellTypeAllFormatConditions)
    ' Pour chaque cellule de la plage utilisée
    For Each Rng In Plage
      ' Vérifier la couleur affichée par la MFC
      If Rng.DisplayFormat.Interior.ColorIndex = 46 Then
        MsgBox ("Vous devez remplir correctement les cellules en orange: ici " & Rng.Address(0, 0))
        Cancel = True
        Application.ScreenUpdating = True
        Exit Sub
      End If
    Next Rng
  Next Sht
  Application.ScreenUpdating = True
 End Sub

Merci de votre participation

Cordialement

Hello BrunoM45

Tout d'abord, merci pour l'accueil chaleureux dans cette vaste communauté et pour ta réponse
Ensuite, ton code fonctionne quasi parfaitement !! En effet, il cherche dans toutes les feuilles s'il n'y a pas une couleur orange et s’il y en a une il se signale. Cependant, lorsqu'il y a aucune MEFC orange, je ne peux pas sauvegarder le fichier, j'obtiens l'erreur "Erreur d'exécution '1004': Pas de cellules correspondantes".

Tu aurais une solution ? J'ai pensé à rajouté un "Else: exit sub" dans le "For each Rn in Plage" mais du coup le code n'est plus fonctionnel. Alors je me suis dis qu'un "Else: ne rien faire" pourrait marcher mais je sais pas comment mettre en place cela

Merci d'avance !!!

Bonjour Louis, Bruno, le forum,

L'erreur ce produit lorsqu'il n'y a aucune mise en forme conditionnel sur la feuille.

Une solution est de forcer l'erreur à passer à la feuille suivante :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  Dim Sht As Worksheet
  Dim Plage As Range, Rng As Range
  ' Pour chaque feuille du classeur
  For Each Sht In ThisWorkbook.Sheets
    ' Définir la plage utilisée

   On error resume next 'Si aucun MFC passe à la feuille suivante

    Set Plage = Sht.UsedRange.SpecialCells(xlCellTypeAllFormatConditions)
    ' Pour chaque cellule de la plage utilisée
    For Each Rng In Plage
      ' Vérifier la couleur affichée par la MFC
      If Rng.DisplayFormat.Interior.ColorIndex = 46 Then
        MsgBox ("Vous devez remplir correctement les cellules en orange: ici " & Rng.Address(0, 0))
        Cancel = True
        Application.ScreenUpdating = True
        Exit Sub
      End If
    Next Rng
  Next Sht
  Application.ScreenUpdating = True
 End Sub

Hello à tous !!

Merci pour ton aide Koko_Swiff !! Justement j'étais en train de manipuler le code et j'ai fais pratiquement comme toi, à différence que je place le "On Error Resume Next" dans la boucle "For Each Rng in Plage" et j'ajoute un "ElseIf Err.Number <> 0 Then Err =0" dans la boucle qui vérifie les MEFC.
Ce que j'ai rajouté fonctionne mais je saurai pas dire si le tien est plus performant ou que le mien rencontrera pas des pb plus tard.
En tout cas merci à vous deux et je poste le code que j'ai modifié aussi

Ps: Je vous remercie encore, j'aurai pas trouvé tout seul d'un coup

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  Dim Sht As Worksheet
  Dim Plage As Range, Rng As Range
  ' Pour chaque feuille du classeur
  For Each Sht In ThisWorkbook.Sheets
    ' Définir la plage utilisée
    Set Plage = Sht.UsedRange.SpecialCells(xlCellTypeAllFormatConditions)
    ' Pour chaque cellule de la plage utilisée
    For Each Rng In Plage

        On Error Resume Next
      ' Vérifier la couleur affichée par la MFC
        If Rng.DisplayFormat.Interior.ColorIndex = 46 Then
            MSgbox "Vous devez remplir correctement les cellules en orange: ici " & Sht.Name & " / " & Rng.Address(0, 0)
            Cancel = True
            Application.ScreenUpdating = True
            Exit Sub
        ElseIf Err.Number <> 0 Then
            Err = 0
        End If
    Next Rng
  Next Sht
  Application.ScreenUpdating = True
 End Sub

Bonjour le fil

Attention de bien penser à mettre

' Retour à la gestion normale des erreurs
On Error Goto 0

à la fin de la procédure, sinon vous risquez d'avoir des surprises