zoeken met vba naar bepaalde celkleur in bepaalde range

[zapatr]

Kijk of je dit bedoelt (zie bijlage).
Alleen als alle cellen paars zijn of alle cellen blauw, kan het bestand worden opgeslagen.

 

[luckybasterd040]

Heb je helemaal gelijk in!
En dan is dit meteen de oplossing!

Nogmaals hartelijk bedankt voor alles!!!

 

[zapatr]

Is het nu in orde, of niet ?
Zie het bestand dat ik 8 minuten geleden postte.

 

[luckybasterd040]

ja dit is het!

Bedankt!

 

[luckybasterd040]

Hallo allemaal,

Ik weet niet of wat ik nu doe mag, maar heb het toppic weer geopend om verder te gaan met deze vraag?!

mijn vraag is nu of ik deze twee kan samenvoegen.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim a As Integer
With Sheets("Code Gen")
'Deze macro is geschreven door Zapatr
a = WorksheetFunction.CountIf(Range("B4:F53"), Range("AV6"))
If WorksheetFunction.And(a > 0, a < 20) Then
Cancel = True
MsgBox ("Please fill in all the questions marked 'Please make your choice' in Sheet 'Code Gen'.")
Else
ThisWorkbook.Saved = True
End If
End With
End Sub

Private Sub Workbook_BeforeSave2(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim a As Integer
With Sheets("Code Gen")
'Deze macro is geschreven door Zapatr
b = WorksheetFunction.CountIf(Range("B4:F53"), Range("F2"))
If WorksheetFunction.And(a > 0, a < 11) Then
Cancel = True
MsgBox ("Please fill in all the red fields in Sheet 'Code Gen'.")
Else
ThisWorkbook.Saved = True
End If
End With

Bedankt Lucas

 

[Cobbe]

Je moet je gepostte code tussen quotes zetten.
Ik heb de code aangepast volgens uw vraag:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
' Deze code is aangepast door Cobbe :)
Dim a As Integer, b As Integer
With Sheets("Code Gen")
'Deze macro is geschreven door Zapatr
a = WorksheetFunction.CountIf(Range("B4:F53"), Range("AV6"))
b = WorksheetFunction.CountIf(Range("B4:F53"), Range("F2"))
If WorksheetFunction.And(a > 0, a < 20) Or WorksheetFunction.And(a > 0, a < 11) Then
Cancel = True
MsgBox ("Please fill in all the questions marked 'Please make your choice' in Sheet 'Code Gen'.")
Else
ThisWorkbook.Saved = True
End If
End With
End Sub

 

[luckybasterd040]

Bedankt,
Deze werkt perfect!

 

[zapatr]

Probeer dit:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim a As Integer, b As Integer, c As Boolean, d As Boolean, mymessage As String
With Sheets("Code Gen")
'Deze code is geschreven door Zapatr
a = WorksheetFunction.CountIf(Range("B4:F53"), Range("AV6"))
b = WorksheetFunction.CountIf(Range("B4:F53"), Range("F2"))
c = WorksheetFunction.And(a > 0, a < 20)
d = WorksheetFunction.And(b > 0, b < 11)
mymesssage = ""
If c Or d Then
Cancel = True
If c Then
MsgBox ("Please fill in all the questions marked" & Chr(13) & _
"'Please make your choice' in Sheet 'Code Gen'.")
End If
If d Then
MsgBox ("Please fill in all the red fields in Sheet 'Code Gen'.")
End If
Else
ThisWorkbook.Saved = True
End If
End With
End Sub

Edit: Let op, bericht werd aangepast.

 

[zapatr]

Ik had begrepen dat bij 2 verschillende situaties ook twee verschillende messageboxen moesten verschijnen.

 

[luckybasterd040]

Bedankt!
Klopt van de twee verschillende messageboxen maar het werkt perfect, maar ik zal de andere ook even proberen!

I.i.g hartelijk bedankt voor uw hulp!

Groetjes Lucas

 

[zapatr]

Let op bij wat Cobbe postte met deze regel:

If WorksheetFunction.And(a > 0, a < 20) Or WorksheetFunction.And(a > 0, a < 11) Then

1.
Het tweede gedeelte (a>0, a< 11) is altijd waar als het eerste gedeelte waar is en kan dus achterwege blijven.
2.
In het tweede gedeelte moet a vervangen worden door b, die is immers daarboven gedefinieerd.
Zie de code in mijn bericht.