M
MikeZz
Hi,
I have a script that draws about 800 lines on a worksheet from various cells
to others. I got the basic routine of the internet and it works perfect in
excel 2003.
However, when I run in 2007, I get an error in the same place evey time.
I've been doing 2003 forever but this is my first venture porting an app from
2003 to 2007.
The error is: "Method 'Select' of object 'Shape' Failed
Look down for this comment line to find where the problem is:
'ERROR HERE: Excel 2003 works with this line.
Any help would be great!
Thanks,
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
'ERROR HERE: Excel 2003 works with this line.
'Excel 2007 gives me this error:
' "Method 'Select' of object 'Shape' Failed
LineShape.Select
ActiveSheet.Hyperlinks.Add Anchor:=LineShape, Address:= _
"", SubAddress:=linkAdd, ScreenTip:=screenTipText
Else
'ERROR HERE: Excel 2003 works with this line.
'Excel 2007 gives me this error:
' "Method 'Select' of object 'Shape' Failed
LineShape.Select
ActiveSheet.Hyperlinks.Add Anchor:=LineShape, Address:= _
"", SubAddress:=linkAdd
End If
End If
End If
Set LineShape = Nothing
End Sub
I have a script that draws about 800 lines on a worksheet from various cells
to others. I got the basic routine of the internet and it works perfect in
excel 2003.
However, when I run in 2007, I get an error in the same place evey time.
I've been doing 2003 forever but this is my first venture porting an app from
2003 to 2007.
The error is: "Method 'Select' of object 'Shape' Failed
Look down for this comment line to find where the problem is:
'ERROR HERE: Excel 2003 works with this line.
Any help would be great!
Thanks,
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
'ERROR HERE: Excel 2003 works with this line.
'Excel 2007 gives me this error:
' "Method 'Select' of object 'Shape' Failed
LineShape.Select
ActiveSheet.Hyperlinks.Add Anchor:=LineShape, Address:= _
"", SubAddress:=linkAdd, ScreenTip:=screenTipText
Else
'ERROR HERE: Excel 2003 works with this line.
'Excel 2007 gives me this error:
' "Method 'Select' of object 'Shape' Failed
LineShape.Select
ActiveSheet.Hyperlinks.Add Anchor:=LineShape, Address:= _
"", SubAddress:=linkAdd
End If
End If
End If
Set LineShape = Nothing
End Sub