Position of a Shape

  • Thread starter Thread starter Gary''s Student
  • Start date Start date
G

Gary''s Student

Somewhere on my worksheet is a single Shape. It is a line with an arrowhead
at one end. The line begins in one cell and ends (arrow head side) in
another cell. How can a macro determine the address of these two cells?

If it matters, the line was drawn by Formula Auditing.

Thanks
 
I've been looking at your problem from when you first posted it... yes, the
Formula Auditing does seem to matter. A normal line has a TopLeftCell and a
BottomRightCell property which you can reference to get their Address
properties; however, lines drawn by the Formula Auditing appear to be
different in that they do not have these properties. I'm still looking (on
and off) at some ideas on how do solve your problem though.
 
I also have been looking at your related post from yesterday, and have at
least the start of a solution. Try this:

Sub FindPrecedents()
'Declare local variables
Dim StartWS As Worksheet, RxRng As Range
Dim c As Range, d As Range
Dim HitCount As Long, NewSht As Worksheet, LastRx As String
On Error Resume Next
'Store the starting activesheet and activecell
Set StartWS = ActiveSheet
'Find all the cells with formulas on the active sheet
Set RxRng = ActiveCell.SpecialCells(xlCellTypeFormulas, 23)
'Add a new worksheet to the current workbook at the end
Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
Set NewSht = ActiveSheet
'Use HitCount& to set the output row. Will add 1 each time,
'so set to 3 initially to begin output on row 4.
HitCount& = 3
'Always start by returning to StartWS.
StartWS.Activate
For Each c In RxRng
Set d = c.NavigateArrow(True, 1)
'If there is no precedent tracing arrow, NavigateArrow returns the selected
cell.
If Intersect(d, c) Is Nothing Then
HitCount& = HitCount& + 1
NewSht.Cells(HitCount&, 1).Value = "'" & ActiveSheet.Name
NewSht.Cells(HitCount&, 2).Value = "'" & c.Address
NewSht.Cells(HitCount&, 3).Value = "'" & c.Formula
End If
Next c
'Done. Clean up. Add headings and resize all columns on NewSht.
NewSht.Activate
NewSht.Cells(3, 1).Value = "Sheet"
NewSht.Cells(3, 2).Value = "Cell"
NewSht.Cells(3, 3).Value = "Formula"
NewSht.Cells.Select
NewSht.Cells.EntireColumn.AutoFit
NewSht.Cells(1, 1).Value = "Precedent tracing for " & StartWS.Name
'Free object variables.
Set NewSht = Nothing
Set StartWS = Nothing
End Sub

As you can see, it uses NavigateArrows to check is a cell has a
precedent-tracing arrow. If there is an arrow, the first precedent cell is
returned. If there is no arrow, the cell being tested is returned.

Hope this helps,

Hutch
 
Thanks for your efforts. I was a little surprised to discover that I could
apply a Method (ShowPrecedents) to a cell, and not have a Property to verify
it had been done.

I later realized that I was just dropping Shapes on the worksheet and maybe
the Shapes could supply the info......
 
I was surprised at that too. However, using Tom's NavigateArrow property (a
new one for me), I have devised a function that appears to work and which
matches the request from your original posting; namely, a simple function
that returns a Boolean indicating whether a cell has Precedent Tracing
turned on or not...

Function IsTracePrecedent(R As Range) As Boolean
Dim StartAddress As String
StartAddress = ActiveCell.Address
If R.HasFormula Then
IsTracePrecedent = R.NavigateArrow(True, 1).Address <> R.Address
End If
Range(StartAddress).Select
End Function

I included the StartAddress stuff so you would not be left in "no man's
land" as the code navigated the arrow, choosing to return you to the active
cell before the function was called.

Also note the function assumes a single cell has been specified for the
argument... you may want to provide error trapping for this, but I didn't
know if you just wanted to quietly exit the sub or if you wanted to raise an
error of some sort, so I left it out of the code so you could handle it
however you wanted to.
 
Excellent Tom... thanks for posting your code... the NavigateArrows property
was a new one for me. Using it, I posted a simple function back to Gary''s
Student in my sub-thread which appears to do what he originally asked for
(given my limited testing on it); namely, a Boolean function to indicate
whether Precedent Tracing was turned on for a cell or not.
 
Fantastic!
I now have a way to "remember" (that is store) the addresses of cells that
have ShowPrecedents turned on.

When I re-open the workbook, I have a way to re-assert those arrows.
 
If your ultimate goal is to produce a list to store for the next time you
open the workbook, then you can use this function to return a comma
separated list of cell addresses for those cells that have Precedent Tracing
turned on for any specified worksheet...

Function PrecedentCells(SheetName As String) As String
Dim C As Range, StartAddress As String
StartAddress = ActiveCell.Address
For Each C In Worksheets(SheetName).Cells.SpecialCells(xlCellTypeFormulas)
If C.NavigateArrow(True, 1).Address <> C.Address Then
PrecedentCells = PrecedentCells & C.Address(0, 0) & ","
End If
Next
If Len(PrecedentCells) Then
PrecedentCells = Left(PrecedentCells, Len(PrecedentCells) - 1)
End If
Range(StartAddress).Select
End Function

Depending on how many of these cells you expect to be in the list, you can
either save the list returned from the function to a cell on the worksheet
it applies to or else save it to an appropriately named text file. Once you
reference or read the list into a String variable (probably in the
Workbook's Open event), you can use this subroutine to turn the Precedent
Tracing on for the specified worksheet for the cells' whose addresses are in
the list...

Sub TurnPrecedentTracingOn(AddressList As String, SheetName As String)
Dim Addr As Variant
For Each Addr In Split(AddressList, ",")
Worksheets(SheetName).Range(Addr).ShowPrecedents
Next
End Sub
 
Back
Top