PDA

View Full Version : Carry text formatting between chart titles



khu
05-02-2014, 11:20 AM
I'm trying to add a filepath to the title of an Excel chart. I simply want to keep the title the same and just append the filepath and then change the filepath formatting later.The original title has two lines, one a larger font and underlined. However, When execute the code:



with chtobj.chart.charttitle
.text = .text & vbCrLf & FilePath
end with


The new title gets blanketed with a default size and underline.

Original Title Format
Original Subtitle format

gets changed to

New Title Format
New Subtitle Format
Filepath

I've tried doing something like:



with chtobj.chart.charttitle
set OrigFont = .characters.font
.text = .text & vbCrLf & filepath
.characters.font = OrigFont
end with


but OrigFont updates to the new blanketed formatting when I change the title.

Is there a way to lock OrigFont so it doesn't update with the chart?

I'd like to be able to capture any formatting throughout the title, so I'm not sure a .character(start, len) type of formatting would work, as I don't know where bold, italics, underline, etc. would occur.

Any help is appreciated, thanks!

Khu

lecxe
05-16-2014, 03:00 AM
Hi Khu

I did a quick test to add a line to a chart title and manipulate the font of that line.

I inserted a simple column chart to the active sheet and added the default title (displayed "Chart title").

The code adds a line after the text displayed in the chart title, and then formats the new line.

Run:



Sub ChartTitleAddFormatLine()
Dim chtTitle As ChartTitle
Dim txtR As TextRange2
Dim lStartLine2 As Long
Dim chtobj As ChartObject
Dim FilePath As String

FilePath = "c:\tmp"

Set chtobj = ActiveSheet.ChartObjects(1)
Set chtTitle = chtobj.Chart.ChartTitle
Set txtR = chtTitle.Format.TextFrame2.TextRange
lStartLine2 = txtR.Characters.Count + Len(vbLf) + 1 ' start of line 2

With txtR
.Characters(Start:=txtR.Characters.Count).InsertAfter vbLf & FilePath
With .Characters(Start:=lStartLine2, Length:=Len(FilePath)).Font
.UnderlineStyle = msoUnderlineSingleLine
.Size = 12
.Italic = True
End With
End With
End Sub



Please try this test first and only then adapt to your case.