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

Hi HG

Macros that require variables passed to them can not be run alone -since
nothing is passed then. That's why they don't appear.

Sub testPass()
Call TestReceive("Yo da man")
End Sub

Sub TestReceive(Msg As String)
MsgBox Msg, , "TestReceive says:"
End Sub

The TestReceive needs variable input, and that is what is put between its
parentheses.

Call the Delete code from immediately after the msgbox in your code to get
rid of it. Note also that ActiveCell may change before the click, so I
suggest you save the creation range and use that for deletion. Adjusted
code:

Option Explicit

Private Const pcfTransparency As Double = 1
Dim RectRange As Range 'NEW
'---------------------------------------------------------------------------

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
Set RectRange = ActiveCell 'NEW
Call AddRectangle(RectRange, "Test") 'MODIFIED
End Sub

Public Sub Test()
' Display a MsgBox
Call MsgBox("It's only a test")
Call DelRectangle(RectRange)'NEW
End Sub

--
HTH. Best wishes Harald
Followup to newsgroup only please

"hglamy" skrev i melding
...
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

Thank you very much for this fast - and well working - reply / solution,
Harald !

Kind regards,

H.G. Lamy


"hglamy" schrieb im Newsbeitrag
...
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

Just don't call SetRectangle twice.

--
Regards,
Tom Ogilvy

"hglamy" wrote in message
...
Thank you very much for this fast - and well working - reply / solution,
Harald !

Kind regards,

H.G. Lamy


"hglamy" schrieb im Newsbeitrag
...
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

Macros that require arguments are not displayed in Tools=Macro=Macros

Public Sub Test()
Dim rct as Shape, sName as String
Dim rng as Range
' Display a MsgBox
Call MsgBox("It's only a test")
sname = Application.Caller
set rct = ActiveSheet.Shapes(rct)
set rng = rct.TopLeftCell
DelRectangle rng
End Sub

--
Regards,
Tom Ogilvy

"hglamy" wrote in message
...
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

Thank you, Tom !

Kind regards,

H.G. Lamy

"Tom Ogilvy" schrieb im Newsbeitrag
...
Macros that require arguments are not displayed in Tools=Macro=Macros

Public Sub Test()
Dim rct as Shape, sName as String
Dim rng as Range
' Display a MsgBox
Call MsgBox("It's only a test")
sname = Application.Caller
set rct = ActiveSheet.Shapes(rct)
set rng = rct.TopLeftCell
DelRectangle rng
End Sub

--
Regards,
Tom Ogilvy

"hglamy" wrote in message
...
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