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
| Option Explicit ' colorier, à partir de la cellule A1, le carré de coté N en rouge
' ========================== Description de la feuille de dessin
Public Const rowSquare = 1 ' Première rangée du carré à colorier
Public Const colSquare = 1 ' Première colonne du carré à colorier
Public Const colorRed = 3
' Prenons l'exemple : je rentre 5. Le carré en question devrait couvrir
' la zone de A1 à E5 mais comment le noter ? Passez en coordonnées L1C1 d'Excel.
Sub Colorier_rouge()
Dim sideOfSquare As Integer, indRow As Integer, indCol As Integer
sideOfSquare = GetSquareSide()
For indRow = rowSquare To rowSquare - 1 + sideOfSquare
For indCol = colSquare To colSquare - 1 + sideOfSquare
Cells(indRow, indCol).Interior.ColorIndex = colorRed
Next
Next
End Sub
' Avec un Range sans boucle
Sub SquareRed()
Dim sideOfSquare As Integer, rngSquare As Range
sideOfSquare = GetSquareSide()
Set rngSquare = Range(Cells(rowSquare, colSquare), _
Cells(rowSquare - 1 + sideOfSquare, colSquare - 1 + sideOfSquare))
rngSquare.Interior.ColorIndex = colorRed
End Sub
' Saisie du côté du carré
Function GetSquareSide() As Integer
Do
On Error Resume Next
GetSquareSide = CInt(InputBox("Saisir le côté du carré à colorier" + vbCrLf + _
"C'est un entier positif supérieur à zéro.", "Red Square"))
If Err.Number <> 0 Then
Warning "1000: Vous devez entrer un NOMBRE entier positif pour le côté du carré"
GetSquareSide = 0
End If
Loop Until GetSquareSide > 0
End Function
' Common error management
Sub Warning(ByVal strMsg As String)
Const lenErr = 4 ' Number of digits of the error code beginning the message
If Err.Number <> 0 Then
strMsg = strMsg + vbCrLf + "Error " + Str(Err.Number) + ": " + Err.Description
End If
MsgBox Mid(strMsg, lenErr + 3), vbExclamation, "Square Red warning " + Left(strMsg, lenErr)
End Sub |
Partager