Rectangle

h = ActiveCell.Height
w2 = ActiveCell.Width
t = ActiveCell.Top
w = ActiveCell.Left

'Teste si les rectangles existent déjà.
On Error Resume Next
ActiveSheet.Shapes("RectangleV").Delete
On Error Resume Next
ActiveSheet.Shapes("RectangleH").Delete
On Error GoTo 0

'Ajoute les rectangles
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 0, t, w, h).Name = "RectangleV"
With ActiveSheet.Shapes("RectangleV")
.Fill.Visible = msoFalse
.Fill.Transparency = 0#
.Line.Weight = 3#
.Line.ForeColor.SchemeColor = 10
.ControlFormat.PrintObject = False
End With

ActiveSheet.Shapes.AddShape(msoShapeRectangle, w, 0, w2, t).Name = "RectangleH"

With ActiveSheet.Shapes("RectangleH")
.Fill.Visible = msoFalse
.Fill.Transparency = 0#
.Line.Weight = 3#
.Line.ForeColor.SchemeColor = 10
.ControlFormat.PrintObject = False
End With


End Sub

Cliquez pour agrandir...

jeanpierre à dit:

Bonjour Adil.costing, Astralon,

C'est normal, c'est une macro événementielle, le copier fonctionne, mais dés que tu veux coller, la macro a pris le pas.


Jean-Pierre

Cliquez pour agrandir...

ogle à dit:

Bonjour,

Une petite question de béotien :

Puisqu'il s'agit d'une macro évènementielle, je ne comprends pas pourquoi, lorsqu'on change de cellule (et donc que la macro se déclenche), la partie en copie est éjectée de la mémoire.

Merci d'avance😀

Cliquez pour agrandir...