2003 vs 2007 Shape Selection Error
 

Hi,
I modifed a routine I found in the internet to draw lines between to cells.
It works perfectly in excel 2003 but 2007 I get the following error:
Method 'Select' of object 'Shape' failed. Run time Error.

in the code look for this line to find the error:
'GET 2007 ERROR HERE (Works in 2003)

Thanks for ANY help! It's driving me nuts.
MikeZz


Private Sub DrawArrow(r1 As Range, r2 As Range, Optional lineName, Optional
linecolor, Optional scriptNo, Optional lineEnds)
' shg 2008-0803
' Draws a line beween the center of the two ranges

Dim x1 As Double
Dim x2 As Double
Dim y1 As Double
Dim y2 As Double
Dim screenTipText
Dim linkR, linkC
Dim linkAdd
Dim LineShape As Shape
Dim cityNo
Dim cityIdx
Dim cityMax
Dim this_Comd
Dim colorThis

Application.StatusBar = "Drawing Arrow: " & scriptNo & " of " & sCount

' Application.ScreenUpdating = True


cityNo = arrScript(scriptNo, script_Type)
cityIdx = arrScript(script_Cidx, script_Type)
cityMax = arrCityInfo(rowCityLast, cityNo)


If IsMissing(linecolor) Then
linecolor = 12
End If

this_Comd = arrScript(scriptNo, script_Comd)
If this_Comd = "attack" Then
colorThis = "Red"
ElseIf this_Comd = "transport" Then
colorThis = "Green"
Else
colorThis = "Black"
End If

With r1
x1 = .Left + .Width / 2
y1 = .Top + .Height / 2
End With

With r2
x2 = .Left + .Width / 2
y2 = .Top + .Height / 2
End With

With shtMap.Shapes.AddLine(x1, y1, x2, y2)
Set LineShape = shtMap.Shapes(shtMap.Shapes.Count)
End With


' LineShape.Line.Visible = False

Dim shpCount

If IsMissing(scriptNo) Then
Else
screenTipText = Get_Arrow_ScreenTip(scriptNo)

shpCount = ActiveSheet.Shapes.Count
linkR = arrScript(scriptNo, script_CelR)
linkC = arrScript(scriptNo, script_CelC)
linkAdd = "Scripts!" & Sheets("Scripts").Cells(linkR, linkC).Address
Application.StatusBar = "Adding Hyperlink Line: " & lineName & " "
& linkAdd

If AddLineHyper = True Then
If AddLineHoover = True Then

'GET 2007 ERROR HERE (Works in 2003)
LineShape.Select
ActiveSheet.Hyperlinks.Add Anchor:=LineShape, Address:= _
"", SubAddress:=linkAdd, ScreenTip:=screenTipText

Else

'GET 2007 ERROR HERE (Works in 2003)
LineShape.Select
ActiveSheet.Hyperlinks.Add Anchor:=LineShape, Address:= _
"", SubAddress:=linkAdd

End If
End If

End If


Set LineShape = Nothing

End Sub

2003 vs 2007 Shape Selection Error
 

You'll get an error if you aren't on the worksheet where the line is. Have
you checked that?
--
HTH,

Barb Reinhardt



"MikeZz" wrote:

Hi,
I modifed a routine I found in the internet to draw lines between to cells.
It works perfectly in excel 2003 but 2007 I get the following error:
Method 'Select' of object 'Shape' failed. Run time Error.

in the code look for this line to find the error:
'GET 2007 ERROR HERE (Works in 2003)

Thanks for ANY help! It's driving me nuts.
MikeZz


Private Sub DrawArrow(r1 As Range, r2 As Range, Optional lineName, Optional
linecolor, Optional scriptNo, Optional lineEnds)
' shg 2008-0803
' Draws a line beween the center of the two ranges

Dim x1 As Double
Dim x2 As Double
Dim y1 As Double
Dim y2 As Double
Dim screenTipText
Dim linkR, linkC
Dim linkAdd
Dim LineShape As Shape
Dim cityNo
Dim cityIdx
Dim cityMax
Dim this_Comd
Dim colorThis

Application.StatusBar = "Drawing Arrow: " & scriptNo & " of " & sCount

' Application.ScreenUpdating = True


cityNo = arrScript(scriptNo, script_Type)
cityIdx = arrScript(script_Cidx, script_Type)
cityMax = arrCityInfo(rowCityLast, cityNo)


If IsMissing(linecolor) Then
linecolor = 12
End If

this_Comd = arrScript(scriptNo, script_Comd)
If this_Comd = "attack" Then
colorThis = "Red"
ElseIf this_Comd = "transport" Then
colorThis = "Green"
Else
colorThis = "Black"
End If

With r1
x1 = .Left + .Width / 2
y1 = .Top + .Height / 2
End With

With r2
x2 = .Left + .Width / 2
y2 = .Top + .Height / 2
End With

With shtMap.Shapes.AddLine(x1, y1, x2, y2)
Set LineShape = shtMap.Shapes(shtMap.Shapes.Count)
End With


' LineShape.Line.Visible = False

Dim shpCount

If IsMissing(scriptNo) Then
Else
screenTipText = Get_Arrow_ScreenTip(scriptNo)

shpCount = ActiveSheet.Shapes.Count
linkR = arrScript(scriptNo, script_CelR)
linkC = arrScript(scriptNo, script_CelC)
linkAdd = "Scripts!" & Sheets("Scripts").Cells(linkR, linkC).Address
Application.StatusBar = "Adding Hyperlink Line: " & lineName & " "
& linkAdd

If AddLineHyper = True Then
If AddLineHoover = True Then

'GET 2007 ERROR HERE (Works in 2003)
LineShape.Select
ActiveSheet.Hyperlinks.Add Anchor:=LineShape, Address:= _
"", SubAddress:=linkAdd, ScreenTip:=screenTipText

Else

'GET 2007 ERROR HERE (Works in 2003)
LineShape.Select
ActiveSheet.Hyperlinks.Add Anchor:=LineShape, Address:= _
"", SubAddress:=linkAdd

End If
End If

End If


Set LineShape = Nothing

End Sub

2003 vs 2007 Shape Selection Error
 

I've encountered problems with this line:

Set LineShape = shtMap.Shapes(shtMap.Shapes.Count)

if there are multiple types of shapes in a worksheet. Different shape
types include those made in 2003 and those made in 2007, as well as
ActiveX controls.

The problem is that different shapes lie in different drawing layers,
and cannot be selected at the same time, in 2007. Because of the
different layers, the last shape added may not have the index .Shapes.Count.

You might be able to use:

Set LineShape = shtMap.Shapes.AddLine(x1, y1, x2, y2)

- Jon
-------
Jon Peltier
Peltier Technical Services, Inc.
http://peltiertech.com/



MikeZz wrote:
Hi,
I modifed a routine I found in the internet to draw lines between to cells.
It works perfectly in excel 2003 but 2007 I get the following error:
Method 'Select' of object 'Shape' failed. Run time Error.

in the code look for this line to find the error:
'GET 2007 ERROR HERE (Works in 2003)

Thanks for ANY help! It's driving me nuts.
MikeZz


Private Sub DrawArrow(r1 As Range, r2 As Range, Optional lineName, Optional
linecolor, Optional scriptNo, Optional lineEnds)
' shg 2008-0803
' Draws a line beween the center of the two ranges

Dim x1 As Double
Dim x2 As Double
Dim y1 As Double
Dim y2 As Double
Dim screenTipText
Dim linkR, linkC
Dim linkAdd
Dim LineShape As Shape
Dim cityNo
Dim cityIdx
Dim cityMax
Dim this_Comd
Dim colorThis

Application.StatusBar = "Drawing Arrow: " & scriptNo & " of " & sCount

' Application.ScreenUpdating = True


cityNo = arrScript(scriptNo, script_Type)
cityIdx = arrScript(script_Cidx, script_Type)
cityMax = arrCityInfo(rowCityLast, cityNo)


If IsMissing(linecolor) Then
linecolor = 12
End If

this_Comd = arrScript(scriptNo, script_Comd)
If this_Comd = "attack" Then
colorThis = "Red"
ElseIf this_Comd = "transport" Then
colorThis = "Green"
Else
colorThis = "Black"
End If

With r1
x1 = .Left + .Width / 2
y1 = .Top + .Height / 2
End With

With r2
x2 = .Left + .Width / 2
y2 = .Top + .Height / 2
End With

With shtMap.Shapes.AddLine(x1, y1, x2, y2)
Set LineShape = shtMap.Shapes(shtMap.Shapes.Count)
End With


' LineShape.Line.Visible = False

Dim shpCount

If IsMissing(scriptNo) Then
Else
screenTipText = Get_Arrow_ScreenTip(scriptNo)

shpCount = ActiveSheet.Shapes.Count
linkR = arrScript(scriptNo, script_CelR)
linkC = arrScript(scriptNo, script_CelC)
linkAdd = "Scripts!" & Sheets("Scripts").Cells(linkR, linkC).Address
Application.StatusBar = "Adding Hyperlink Line: " & lineName & " "
& linkAdd

If AddLineHyper = True Then
If AddLineHoover = True Then

'GET 2007 ERROR HERE (Works in 2003)
LineShape.Select
ActiveSheet.Hyperlinks.Add Anchor:=LineShape, Address:= _
"", SubAddress:=linkAdd, ScreenTip:=screenTipText

Else

'GET 2007 ERROR HERE (Works in 2003)
LineShape.Select
ActiveSheet.Hyperlinks.Add Anchor:=LineShape, Address:= _
"", SubAddress:=linkAdd

End If
End If

End If


Set LineShape = Nothing

End Sub

2003 vs 2007 Shape Selection Error
 

I could not try your code; but I dont see any reason why you should select
the shape at all to assign a hyperlink. Remove that line and try..running in
both versions...

If this post helps click Yes
---------------
Jacob Skaria


"MikeZz" wrote:

Hi,
I modifed a routine I found in the internet to draw lines between to cells.
It works perfectly in excel 2003 but 2007 I get the following error:
Method 'Select' of object 'Shape' failed. Run time Error.

in the code look for this line to find the error:
'GET 2007 ERROR HERE (Works in 2003)

Thanks for ANY help! It's driving me nuts.
MikeZz


Private Sub DrawArrow(r1 As Range, r2 As Range, Optional lineName, Optional
linecolor, Optional scriptNo, Optional lineEnds)
' shg 2008-0803
' Draws a line beween the center of the two ranges

Dim x1 As Double
Dim x2 As Double
Dim y1 As Double
Dim y2 As Double
Dim screenTipText
Dim linkR, linkC
Dim linkAdd
Dim LineShape As Shape
Dim cityNo
Dim cityIdx
Dim cityMax
Dim this_Comd
Dim colorThis

Application.StatusBar = "Drawing Arrow: " & scriptNo & " of " & sCount

' Application.ScreenUpdating = True


cityNo = arrScript(scriptNo, script_Type)
cityIdx = arrScript(script_Cidx, script_Type)
cityMax = arrCityInfo(rowCityLast, cityNo)


If IsMissing(linecolor) Then
linecolor = 12
End If

this_Comd = arrScript(scriptNo, script_Comd)
If this_Comd = "attack" Then
colorThis = "Red"
ElseIf this_Comd = "transport" Then
colorThis = "Green"
Else
colorThis = "Black"
End If

With r1
x1 = .Left + .Width / 2
y1 = .Top + .Height / 2
End With

With r2
x2 = .Left + .Width / 2
y2 = .Top + .Height / 2
End With

With shtMap.Shapes.AddLine(x1, y1, x2, y2)
Set LineShape = shtMap.Shapes(shtMap.Shapes.Count)
End With


' LineShape.Line.Visible = False

Dim shpCount

If IsMissing(scriptNo) Then
Else
screenTipText = Get_Arrow_ScreenTip(scriptNo)

shpCount = ActiveSheet.Shapes.Count
linkR = arrScript(scriptNo, script_CelR)
linkC = arrScript(scriptNo, script_CelC)
linkAdd = "Scripts!" & Sheets("Scripts").Cells(linkR, linkC).Address
Application.StatusBar = "Adding Hyperlink Line: " & lineName & " "
& linkAdd

If AddLineHyper = True Then
If AddLineHoover = True Then

'GET 2007 ERROR HERE (Works in 2003)
LineShape.Select
ActiveSheet.Hyperlinks.Add Anchor:=LineShape, Address:= _
"", SubAddress:=linkAdd, ScreenTip:=screenTipText

Else

'GET 2007 ERROR HERE (Works in 2003)
LineShape.Select
ActiveSheet.Hyperlinks.Add Anchor:=LineShape, Address:= _
"", SubAddress:=linkAdd

End If
End If

End If


Set LineShape = Nothing

End Sub