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
>
>
>
>
>
Similar Threads
