Macro Error that I connot figure out

R

Rodby

I am trying to teach myself VBA using Step by Step by Reed Jacobson.
There is a chapter on graphical objects, and in one macro he shows how to
set up an "active map" forma generic state map
Here is the macro:
Sub MakeMapButtons()
Dim s As Shape
myNumber = 3
myName = "oregon"
myCaption = "OR"
myColor = 9
Set s = ActiveSheet.Shapes(1).GroupItems(myNumber)
's.Select
s.Name = myName
s.Fill.ForeColor.ObjectThemeColor = myColor
s.ThreeD.BevelTopDepth = 6
s.TextFrame2.TextRange = myCaption
s.TextFrame2.HorizontalAnchor = msoAnchorCenter
s.TextFrame2.VerticalAnchor = msoAnchorMiddle
s.TextFrame2.TextRange.Font.Size = 20
s.TextFrame2.TextRange.Font.Bold = msoTrue
s.TextFrame2.TextRange.Font.Fill.ForeColor.ObjectThemeColor =
msoThemeColorLight1
s.Fill.OneColorGradient msoGradientHorizontal, 1, 0
s.TextFrame2.TextRange.Font.Reflection.Type = msoReflectionType5
s.Parent.Parent.Ungroup
s.OnAction = ThisWorkbook.Name & "!StateButton"
s.DrawingObject.ShapeRange.Regroup

Everything works fine until the third line from the bottom:
s.Parent.Parent.Ungroup

I get an error message saying that the object does not support this property.
I copied this program from his answer file and pasted it directly into the
macro shell, so I know that I did not make a typing error, but it still hangs
up.

Any thoughts?
 
B

Barb Reinhardt

I *think* you have one too many "Parent" in there, but it's hard to tell.

Try adding this before your line with the error.

debug.print s.parent.name
debug.print s.parent.parent.name

Does that help you figure anything out?

I suspect that s.parent.parent is the worksheet,
 
H

Hakyab

I believe s.parent returns the worksheet, probably s.parent.parent is the
workbook.

You want to use s.parentgroup to get the entie shape group.

I posted a problem with shape groups earlier, which did not get any
attention. There may be a bug with this object.

Best,
 
B

Barb Reinhardt

Maybe it would be advantagous for the OP todefine a ShapeGroup object as they
are getting to "s" and then just act on that object.
 
R

Rodby

Thanks,
I put in the steps, and s.parent,name is the worksheet while s.parent.parent
is the workbook. I think I want to "ungroup" (whatever that means) from the
collection of states which is the map of the states.

The idea of the program is to set it up so you can click on the state to
perform an action.

In any event, the statement s.parent.parent.ungroup would seem to separate
the state from the workbook? That does not seem to make any sense.
 
R

Rodby

I tried you suggestion, but I got an error message: The object does not
support the property or method.
 
H

Hakyab

Your error is probably related to the bug I mentioned. Try to observe the
value of

ActiveSheet.Shapes(1).GroupItems(myNumber).Child

This ought to be 1, describing the shape as part of a group. If this is like
the error I encountered, you will see a 0 here, hence as far as VBA is
concerned, there is no parent group.

My trials indicate that if you copy and paste the group of shapes to another
sheet, you get this bug. If this is the case, do ungrouping and gouping
manually once on the new sheet and try again.

HTH
 
R

Rodby

Thanks, I will try the suggested statement. As far as "manually" ungrouping,
this goes far beyond what I know how to do, but I will try the Excel help
function.

Thanks again
 
M

miroen

Rodby wrote on 03/21/2010 16:44 ET :
I tried you suggestion, but I got an error message: The object does not
support the property or method.
Click to expand...
Here is a working version of this macro:

Sub MakeMapButtons()
Dim s As Shape
Dim t As Shape
myNumber = 4
myName = "Washington"
myCaption = "WS"
myColor = 6
Set t = ActiveSheet.Shapes(1)
Set s = t.GroupItems(myNumber)
s.Name = myName
s.Select
s.Fill.ForeColor.ObjectThemeColor = myColor
s.ThreeD.BevelTopDepth = 6
s.TextFrame2.TextRange = myCaption
s.TextFrame2.HorizontalAnchor = msoAnchorCenter
s.TextFrame2.VerticalAnchor = msoAnchorMiddle
s.TextFrame2.TextRange.Font.Size = 20
s.TextFrame2.TextRange.Font.Bold = msoTrue
s.TextFrame2.TextRange.Font.Fill.ForeColor.ObjectThemeColor
msoThemeColorLight1
s.Fill.OneColorGradient msoGradientHorizontal, 1, 0
s.TextFrame2.TextRange.Font.Reflection.Type = msoReflectionType5
MsgBox s.Name
t.Ungroup
s.OnAction = "StateButton"
s.DrawingObject.ShapeRange.Regroup
End Sub


good luck with it!!
 
Top