Macro : Sauver fichier si la condition est remplie

[Soleil11]

Bonjour le forum,

J'aimerais de l'aide afin de finaliser mon code et savoir si cela est possible d'être réaliser en VBA. Voici le code que j'ai tapper ci-dessous selon mes connaissances.

Lorsque je clique pour sauver mon fichier j'aimerais que les celulles soient contrôlées pour les colonnes A à R. Si certaines cellules contiennent du text ou nombre en rouge l'enregistrement devrait être arrêter et le MsgBox ci-dessous devrait être affiché.

For each c in Range("A1:R65000")
    If c.Font.Color = RGB(255, 0, 0) Then
         'Sauver le document
    Else
         'ne pas sauver le document

         MsgBox ("Document ne peut être sauver erreur dans certaines cellules")
    End If
Next

Merci pour votre aide.

Soleil11

 

[xhudi69]

Re : Macro : Sauver fichier si la condition est remplie

Bonjour Soleil11, le Forum,

essaies ceci:

Sub Sauver()
Dim c As Range, Compte As Double

Compte = 0
For Each c In Range("A1:R65000")
    If c.Font.Color = RGB(255, 0, 0) Or IsNumeric(c.Value) = True Then
        Compte = Compte + 1
    End If
Next c
    If Compte > 0 Then
         MsgBox ("Document ne peut être sauver erreur dans certaines cellules")
         Exit Sub
    Else
        'Procedure sauve fichier.....
    End If
End Sub

@+

 

[Iznogood1]

Re : Macro : Sauver fichier si la condition est remplie

Salut,

dans ThisWorkBook, ajoute un code du genre :

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  If Not Controle Then
    MsgBox "Ce document ne peut pas être sauvé" & vbCrLf & "Il y a des erreurs dans certaines cellules", vbExclamation Or vbOKOnly, "Erreurs"
    Cancel = True
  End If
End Sub

Private Function Controle() As Boolean
  Dim r As Range
  Controle = True
  For Each r In Feuil1.Range("A1:A" & Feuil1.[A1].End(xlDown).Row)
    If r.Font.Color <> RGB(255, 0, 0) Then
      Controle = False
      Exit Function
    End If
  Next r
End Function

 

[Soleil11]

Re : Macro : Sauver fichier si la condition est remplie

Salut,

dans ThisWorkBook, ajoute un code du genre :

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  If Not Controle Then
    MsgBox "Ce document ne peut pas être sauvé" & vbCrLf & "Il y a des erreurs dans certaines cellules", vbExclamation Or vbOKOnly, "Erreurs"
    Cancel = True
  End If
End Sub

Private Function Controle() As Boolean
  Dim r As Range
  Controle = True
  For Each r In Feuil1.Range("A1:A" & Feuil1.[A1].End(xlDown).Row)
    If r.Font.Color <> RGB(255, 0, 0) Then
      Controle = False
      Exit Function
    End If
  Next r
End Function

Rebonjour,

J'ai testé votre dernier code que j'ai ajouté dans "ThisWorkbook" le message MsgBox s'affiche bien lorsqu'il trouve du texte en rouge et il ne sauve pas le document. Par contre, si je fais le test contraire il m'affiche quand même MsBox mais il ne sauve pas le fichier et la fenêtre Msbox devrait normalement ne pas apparaître puisqu'il ne trouve rien. J'ai ajouter un fichier test dans les pièces jointes avec le test contraire.

Je ne sais si mes explications sont assez claire.

Merci en tout cas de votre aide.

Soleil11

 

[Iznogood1]

Re : Macro : Sauver fichier si la condition est remplie

L'enregistrement n'est autorisé que si toutes les cellules sont écrites en rouge.

Si ce n'est pas le comportement voulu, il faut changer le code de la fonction Controle

 

[Soleil11]

Re : Macro : Sauver fichier si la condition est remplie

C'est tout a fait ce qu'il faut comme macro avant de sauver le document, mais le comportement c'est plutôt le contraire :

Test positif :

1.L'enregistrement devrait être autorisé que si il ne trouve plus aucunes cellules écrites en rouge.

2.Il sauve le document

Test negatif :

1. Si il trouve des cellules écrites en rouge

2. Il stoppe l'enregistrement, et il ne sauve pas le fichier.

J'espère que ces exemples sont plus claires.

Merci pour votre patience...

Soleil11

 

[Iznogood1]

Re : Macro : Sauver fichier si la condition est remplie

Il suffit donc de remplacer "<>" par "=" dans la fonction "Contrôle"

If r.Font.Color = RGB(255, 0, 0) Then

 

[Soleil11]

Re : Macro : Sauver fichier si la condition est remplie

Cela joue parfaitement.

Merci à vous tous pour votre aide.

Soleil11

 

[Soleil11]

Re : Macro : Sauver fichier si la condition est remplie

Rebonjour,

Je viens de m'apercevoir qu'il fallait que cela fonctionne pour la feuille 1(sheet1) et la feuille 2 (sheet 2). Désolé de vous demandé à nouveau de l'aide pour modifier le code ci-dessous il faudrait qui'il applique le même code aussi pour la feuille2:

For Each r In Feuil1.Range("A1:A" & Feuil1.[A1].End(xlDown).Row)

Merci encore de votre aide.

Soleil11

 

[Iznogood1]

Re : Macro : Sauver fichier si la condition est remplie

Private Function Controle() As Boolean
  Dim r As Range
  Dim sheets
  sheets = Array("Sheet1", "Sheet2")
  Dim sh As Variant
  Controle = True
  For Each sh In sheets
    For Each r In Worksheets(sh).Range("A1:A" & Worksheets(sh).[A1].End(xlDown).Row)
      If r.Font.Color = RGB(255, 0, 0) Then
        Controle = False
        Exit Function
      End If
    Next r
  Next sh
End Function

 

[Soleil11]

Re : Macro : Sauver fichier si la condition est remplie

Au début cela fonctionnait pour les deux feuilles avec le nom (sheet1 et sheet2). Lorsque j'ai renommé les deux feuilles cela ne fonctionnait plus ci-dessous mon fichier test.

Soleil11

 

[Soleil11]

Re : Macro : Sauver fichier si la condition est remplie

J'ai trouvé ou était le problème, la macro fonctionne très bien j'avais un espace dans le nom de la feuille.

Merci à tous le forum pour votre grande aide.

Soleil11