Private Sub ToggleButton1_Click()
With ToggleButton1
If .Value = True Then
h = ActiveCell.Height
'Largeur de la cellule active
w2 = ActiveCell.Width
'Hauteur entre la cellule active et la première ligne
t = ActiveCell.Top
'Largeur entre la cellule active et la première colonne
w = ActiveCell.Left
'Teste si les rectangles existent déjà. Dans ce cas, on les efface.
'On utilise ici On Error Resume Next, qui permet de tester
' l'erreur de création d'un rectangle en double portant le même nom.
On Error Resume Next
ActiveSheet.Shapes("RectangleV").Delete
On Error Resume Next
ActiveSheet.Shapes("RectangleH").Delete
' Ajoute les rectangles en fonction des coordonnées précédemment calculées.
' Les rectangles sont transparents, de grosseur 3 et de couleur rouge (10)
' On ne peut pas les imprimer.
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 0, t, w, h).Name = "RectangleV"
With ActiveSheet.Shapes("RectangleV")
.Fill.Visible = msoFalse
.Fill.Transparency = 3#
.Line.Weight = 3#
.Line.ForeColor.SchemeColor = 10
.PrintObject = False
End With
ActiveSheet.Shapes.AddShape(msoShapeRectangle, w, 0, w2, t).Name = "RectangleH"
With ActiveSheet.Shapes("RectangleH")
.Fill.Visible = msoFalse
.Fill.Transparency = 3#
.Line.Weight = 3#
.Line.ForeColor.SchemeColor = 10
.PrintObject = False
End With
ElseIf .Value = False Then
Exit Sub
End If
End With
End Sub