H
hglamy
Hello there,
I copied code the following 4 procedures from a website into an xl code
module,
as the instruction read.
Its intention is to create invisible reactangles around a cell,
which in turn can fire a macro when the "cell" is clicked.
Thereafter, the rectangle shall be deleted again..
However, only 2 of those procedures (SetRectangle and Test) appear in the
macros list, whatever I try.
What may go wrong ?
'---------------------------------------------------------------------------
-----
Private Const pcfTransparency As Double = 1
'---------------------------------------------------------------------------
-----
Sub AddRectangle(r As Excel.Range, tOnAction As String)
Dim rect As Shape
Call DelRectangle(r)
'Create the shape
With r.Cells(1, 1)
Set rect = .Parent.Shapes.AddShape(1, .Left, .Top, .Width, .Height)
'Make it invisible
With rect
.Fill.Transparency = pcfTransparency
.Line.Transparency = pcfTransparency
.Name = "rectRow" & r.Cells(1, 1).Row & "Col" & _
r.Cells(1, 1).Column
If tOnAction <> vbNullString Then
.OnAction = tOnAction
End If
End With
End With
End Sub
'---------------------------------------------------------------------------
-----
Sub DelRectangle(r As Excel.Range)
Dim rect As Shape
'Delete the shape
With r
For Each rect In .Parent.Shapes
If rect.Name = "rectRow" & r.Cells(1, 1).Row & "Col" & _
r.Cells(1, 1).Column Then
rect.Delete
Exit Sub
End If
Next rect
End With
End Sub
'---------------------------------------------------------------------------
-----
Public Sub SetRectangle()
' Create a test environment
Call AddRectangle(ActiveCell, "Test")
End Sub
'---------------------------------------------------------------------------
-----
Public Sub Test()
' Display a MsgBox
Call MsgBox("It's only a test")
End Sub
<<<<<<<<<<<<<<<<<<<<<<<<<
What I want is automatically getting rid of the freshly created rectangles
as soon as the
"test"-procedure runs.
Your help is greatly appreciated.
Kind regards,
H.G. Lamy
I copied code the following 4 procedures from a website into an xl code
module,
as the instruction read.
Its intention is to create invisible reactangles around a cell,
which in turn can fire a macro when the "cell" is clicked.
Thereafter, the rectangle shall be deleted again..
However, only 2 of those procedures (SetRectangle and Test) appear in the
macros list, whatever I try.
What may go wrong ?
'---------------------------------------------------------------------------
-----
Private Const pcfTransparency As Double = 1
'---------------------------------------------------------------------------
-----
Sub AddRectangle(r As Excel.Range, tOnAction As String)
Dim rect As Shape
Call DelRectangle(r)
'Create the shape
With r.Cells(1, 1)
Set rect = .Parent.Shapes.AddShape(1, .Left, .Top, .Width, .Height)
'Make it invisible
With rect
.Fill.Transparency = pcfTransparency
.Line.Transparency = pcfTransparency
.Name = "rectRow" & r.Cells(1, 1).Row & "Col" & _
r.Cells(1, 1).Column
If tOnAction <> vbNullString Then
.OnAction = tOnAction
End If
End With
End With
End Sub
'---------------------------------------------------------------------------
-----
Sub DelRectangle(r As Excel.Range)
Dim rect As Shape
'Delete the shape
With r
For Each rect In .Parent.Shapes
If rect.Name = "rectRow" & r.Cells(1, 1).Row & "Col" & _
r.Cells(1, 1).Column Then
rect.Delete
Exit Sub
End If
Next rect
End With
End Sub
'---------------------------------------------------------------------------
-----
Public Sub SetRectangle()
' Create a test environment
Call AddRectangle(ActiveCell, "Test")
End Sub
'---------------------------------------------------------------------------
-----
Public Sub Test()
' Display a MsgBox
Call MsgBox("It's only a test")
End Sub
<<<<<<<<<<<<<<<<<<<<<<<<<
What I want is automatically getting rid of the freshly created rectangles
as soon as the
"test"-procedure runs.
Your help is greatly appreciated.
Kind regards,
H.G. Lamy