Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

using vba to position text boxes and arrows in a chart?!

Status
Not open for further replies.

eHanSolo

Technical User
May 24, 2004
260
GB
hi there,

I have a chart that has a number of text boxes and arrows already on it. the data gets updated from time to time and it's an absolute pain to re-position everything (cuz everything gets shifted out of place).

Is there a way to find out the position of the chart, the line, and the relative position of the text boxes and arrows so i can position things using vba??

any tips or pointers would be greatly appreciated!!

e
 



Hi,

Here's an exmple of code that I have used on a chart to position shapes to roughly align with series points.
Code:
Sub ChartAnnotations()
    Dim pt As Point, txt As Object, arw As Object, i As Integer
    RemoveRectangles
    i = 1
'wsChart is my Sheet Object
    For Each pt In wsChart.ChartObjects(1).Chart.SeriesCollection(2).Points
        pt.HasDataLabel = True
        With pt.DataLabel
            Set txt = wsChart.ChartObjects(1).Chart.TextBoxes.Add(.Left, .Top - 60, 70, 30)
            With txt
                .AutoSize = True
'I have a Named Range "Note" where my annotation text resides
                .Formula = "=" & wsChart.Name & "!" & Range("Note")(i).Address
                .Left = .Left - .Width / 2
                .Interior.ColorIndex = 36
                .Name = "txt" & i
            End With
            Set arw = wsChart.ChartObjects(1).Chart.Shapes.AddShape( _
                msoShapeDownArrow, txt.Left, txt.Top + txt.Height, 25, 35)
            With arw
                .Left = .Left + txt.Width / 2 - .Width / 2
                .Fill.ForeColor.SchemeColor = 43
                .Line.Visible = msoFalse
                .Name = "arw" & i
            End With
            If Range("Note")(i) = "" Then
                txt.Visible = False
                arw.Visible = False
            Else
                txt.Visible = True
                arw.Visible = True
            End If
        End With
        pt.HasDataLabel = False
        i = i + 1
    Next
End Sub
Sub RemoveRectangles()
    Dim rec As Object
    For Each rec In wsChart.ChartObjects(1).Chart.Shapes
        Select Case Left(rec.Name, 3)
            Case "arw", "txt"
                rec.Delete
        End Select
    Next
End Sub

Skip,

[glasses] [red][/red]
[tongue]
 
Great! i'll give it a go.

thanks for your help there!

best


e
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top