1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62
| Option Explicit
Sub ControlerUneFeuille(ByVal FeuilleControlee As Worksheet, ByVal LigneTitre As Long, ByVal ColonneControlee As Long)
Dim DerniereLigneControle As Long
Dim AireControlee As Range
Dim CelluleControlee As Range
Dim ResultatControle As String
With FeuilleControlee
DerniereLigneControle = .Cells(.Rows.Count, ColonneControlee).End(xlUp).Row
ResultatControle = "Absence valeurs aux lignes : "
If DerniereLigneControle > LigneTitre Then
Set AireControlee = .Range(.Cells(LigneTitre + 1, ColonneControlee), .Cells(DerniereLigneControle, ColonneControlee))
For Each CelluleControlee In AireControlee
If ControlerUneCellule(CelluleControlee) <> "Absence de valeur dans les cellules : " Then
ResultatControle = ResultatControle & CelluleControlee.Row & ", "
End If
Next CelluleControlee
If ResultatControle <> "Absence valeurs aux lignes : " Then
MsgBox ResultatControle, vbCritical, "Contrôle des saisies dans les colonnes E, F et H"
End If
Set AireControlee = Nothing
End If
End With
End Sub
Function ControlerUneCellule(ByVal CelluleControlee As Range) As String
ControlerUneCellule = "Absence de valeur dans les cellules : "
With CelluleControlee
If .Value <> "" Then
If .Offset(0, 2) = "" Then
.Offset(0, 2).Interior.Color = RGB(255, 0, 0)
ControlerUneCellule = ControlerUneCellule & .Offset(0, 2).Address & ", "
Else
.Offset(0, 2).Interior.Color = xlNone
End If
If .Offset(0, 3) = "" Then
.Offset(0, 3).Interior.Color = RGB(255, 0, 0)
ControlerUneCellule = ControlerUneCellule & .Offset(0, 3).Address & ", "
Else
.Offset(0, 3).Interior.Color = xlNone
End If
If .Offset(0, 5) = "" Then
.Offset(0, 5).Interior.Color = RGB(255, 0, 0)
ControlerUneCellule = ControlerUneCellule & .Offset(0, 5).Address
Else
.Offset(0, 5).Interior.Color = xlNone
End If
End If
End With
End Function |
Partager