View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
hglamy[_2_] hglamy[_2_] is offline
external usenet poster
 
Posts: 17
Default Macros not appearing in the Tools Macro Macros list

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