Can't change macro assigned to drawing object

[Guest]

Hi All:

I'm writing an app under Excel 9 and Windows 98SE. I have several drawing
objects on the sheet, and a unique macro is assigned to each object. I also
have two workbooks open simultaneously. The problem is that I can't change
the macro assignments. For some reason Excel is trying to run a macro with
the "right" name but under the "wrong" workbook. I've tried right-clicking on
the drawing object and repeating the "assign" command but Excel leaves the
assignment unchanged. I've tried it with the sheets and workbooks protected
and un-protected, with the second workbook open and closed, with the target
macros in different code modules, etc. I've tried selecting the macro from
the list in the Assign Macro box, typing it myself (qualified and
un-qualified), recording a new one and replacing the code, etc. Nothing seems
to work. Anybody have any idea what I'm doing wrong? Thanks...

--
Mark B.
Hampstead, NC USA

"Perpetual optimism is a force multiplier."
- Gen. Colin Powell

 

[Peter T]

If I follow you have two workbooks each with similar objects with their
OnAction properties set to trigger similarly named macros in their own
workbook.

Are you absolutely sure the named macros exist in both workbooks. If not, if
you try to qualify the onaction to a non existent macro in own workbook it
will continue to point to the macro in the other workbook which presumably
does exist. Do you filter the macros in the dialog to show only those in
ThisWorkbook.

Or perhaps Excel is getting confused with similarly named macros in
different workbooks.
This should relink to macros in own workbook or flag a problem if the macro
doesn't exist in own workbook (the macro onaction will remain unchanged).

Sub ReAssignMacros()
Dim nPos As Long
Dim sMacro As String
Dim sOrig As String
Dim sMacroPrefix As String
Dim shp As Shape

sMacroPrefix = "'" & ActiveWorkbook.Name & "'!"

For Each shp In ActiveSheet.Shapes
sMacro = "": sOrig = "": nPos = 0
sMacro = shp.OnAction
sOrig = sMacro
If Len(sMacro) Then

nPos = InStr(1, sMacro, "!")
If nPos Then
sMacro = Right(sMacro, Len(sMacro) - nPos)
End If

On Error Resume Next
sMacro = sMacroPrefix & sMacro
shp.OnAction = sMacro

If Err.Number Then
Debug.Print shp.Name, Err.Description
End If

On Error GoTo 0
Else
sOrig = "no macro"
End If

Debug.Print shp.Name, shp.OnAction, sOrig
Next
End Sub

Regards,
Peter T

 

[Guest]

Hi Peter:

Re: similar names. Kinda. Workbook #2 feeds data to workbook #1 for display.
They are similar in structure & content. Both have macros triggered by
clicking drawing objects, but the macro names are distinct and their
functions very different. So, the named macros exist only in the active
workbook.

Either way, your code should point me in the right direction. I'll let you
know what happens, & thanks!
--
Mark B.
Hampstead, NC USA

"Perpetual optimism is a force multiplier."
- Gen. Colin Powell

 

[Guest]

Hi Peter:

Well, that was interesting...

I ran your code & got some very interesting results. It listed about two
dozen occurances for each shape, all on the sheet where I'd created eight
text boxes. I played around with it a bit, and as best I can determine it
seems that each time I make a change to a drawing object (re-size, re-name,
etc.), Excel creates a new occurance of every shape on the page in the shapes
collection. Is this a bug or just something I overlooked? If a bug, I suppose
it's a little late to report it now ;-) Thanks...
--
Mark B.
Hampstead, NC USA

"Perpetual optimism is a force multiplier."
- Gen. Colin Powell

 

[Peter T]

Hi Mark,

I expect what's happened is over a period of time you have deleted entire
rows or columns containing shapes with the not unreasonable assumption that
will also delete those shapes. It doesn't, merely makes their width or
height zero, effectively not visible.

Sub DelThinShapes()
Dim shp As Shape

For Each shp In ActiveSheet.Shapes
If shp.Width < 0.5 Or shp.Height < 0.5 Then
Debug.Print shp.Name, shp.TopLeftCell.Address(0, 0), "* ",
shp.Width, shp.Height
'shp.Delete
Else
Debug.Print shp.Name, shp.TopLeftCell.Address(0, 0), " ";
shp.Width, shp.Height
End If
Next

End Sub

Satisfy yourself you want to delete the shapes marked * and uncomment
shp.Delete

I'm not sure if this is related to your original problem or a separate
issue..

Regards,
Peter T

 

[Guest]

Hi Peter:

You're probably right about deleting rows, but while playing around with the
sheet I found that making changes to the text box would create a new
occurance without deleting the old one. In my original sheet, there were
about 20 occurances per object. Some pointed to the macro I wanted, some
pointed to default macros (which may or may not have existed), etc. I can
only guess that, with so many occurances, I might change the assignment for
any given occurance, but who knows which one was activated with OnAction?
Anyway, I did basically what you suggested: deleted them all with a macro,
created new ones, and assigned their actions with another macro. Not done
testing yet, but I think that'll work. Thanks again for all your help.
--
Mark B.
Hampstead, NC USA

"Perpetual optimism is a force multiplier."
- Gen. Colin Powell