Solved: How to find/calculate height & width of chart title in Excel VBA?

[agarwaldvk]

Hi Everybody

This is a cut down version of the requirement. Say if I have a graph which has a chart title. I want to have this chart title centered across the width of the plot area (horizontal centering) and I also want it placed vertically midway in the space between the top of the chart area and the top of the plot area.

For some reason the horizontalalignment and the verticalalignment properties of the charttitle object doesn't seem to respond whilst some of the other properties such as left, top etc seem to respond.

Any suggestions, please!

I do not have the code here at home but I shall post the code that I was trying to use at work todyay tomorrow.

As an alternative, I was trying to find if I can get the height and the width of the charttitle object but apparently that is not a property that is available for this object. Any suggestions how to work it out?


Best regards


Deepak Agarwal

[Bob Phillips]

We await your code with bated breath.

[Andy Pope]

The charttitle, along with the other textual boxes in a chart, do not have a Width or Height property.
One way you can get a pretty close approximation is to use the fact that you can not position the text outside of the chartarea. If you try it will end up as close as possible but still within bounds. So you can use the difference between intended location and actual to calculate height or with.

Sub CenterChartTitle()

    Dim sngWidth As Single
    Dim sngHeight As Single
    Dim sngLeft As Single
    Dim sngTop As Single
    
    With ActiveChart
        If .HasTitle Then
            .ChartTitle.Left = .ChartArea.Width
            sngWidth = .ChartArea.Width - .ChartTitle.Left
            .ChartTitle.Top = .ChartArea.Height
            sngHeight = .ChartArea.Height - .ChartTitle.Top
            .ChartTitle.Left = .PlotArea.InsideLeft + ((.PlotArea.InsideWidth - sngWidth) / 2)
            .ChartTitle.Top = ((.PlotArea.InsideTop - sngHeight) / 2)
        End If
    End With
    
End Sub

[agarwaldvk]

Hi Everybody

This is the code that I had in mind. Not all of it is mine! Some part of it is by Jon Peltier (for determiing the
CharttitleHeight - very similar (in fact almost identical to what you have indicated, Andy). I have just extended
it to work out the ChartTitleWidth).

This seems to work ok. However, when I try and copy the chart (which is a ChartOobject object (I think) - may even
be a Chart object - and paste it as a picture - even after specifying the Top/Left/Height/Width parameters for the
picture, it still doesn't come out to be exactly the same size as the range that it is supposed to covering. It might be
noted that the original chart exactly and fully covering the underlying range but the copied chart (pasted as a picture)
doesn't. It is marginally smaller. Is there a way to get it exactly the same size as the original?

[vba]
Sub CopyChartsAsPictures()
Dim thisObjectTop As Long, thisObjectLeft As Long
Dim myDocument As Worksheet
Dim start1 As Integer, wrkg1 As Integer

Dim plotAreaLeft As Double, plotAreaWidth As Double, plotAreaTop As Double, plotAreaHeight As Double
Dim chartArealeft As Double, chartAreaWidth As Double, chartAreaHeight As Double, chartAreaTop As Double
Dim chartTitleHeight As Double, chartTitleWidth As Double
Dim valueAxisLeft As Double, valueAxisTop As Double

Dim graphSheetName As String
graphSheetName = "Comparative Graphs"
Worksheets(graphSheetName).Activate
ActiveSheet.Cells(1, 1).Select
Set myDocument = ActiveSheet
thisSheetChartCount = myDocument.ChartObjects.Count
start1 = 1: wrkg1 = start1
Do While wrkg1 <= thisSheetChartCount
myDocument.ChartObjects(wrkg1).Select
thisObjectTop = Selection.Top
thisObjectLeft = Selection.Left


With myDocument.ChartObjects(wrkg1).Chart
.HasTitle = True
plotAreaLeft = .PlotArea.Left: chartArealeft = .ChartArea.Left
plotAreaTop = .PlotArea.Top: chartAreaTop = .ChartArea.Top
plotAreaWidth = .PlotArea.Width: chartAreaWidth = .ChartArea.Width
plotAreaHeight = .PlotArea.Height
chartAreaHeight = .ChartArea.Height
valueAxisLeft = .Axes(xlValue).Left
valueAxisTop = .Axes(xlValue).Top
.ChartTitle.Top = chartAreaHeight 'By Jon Peltier
chartTitleHeight = (.ChartArea.Height - .ChartTitle.Top) 'By JP
.ChartTitle.Top = (Round(((valueAxisTop - chartAreaTop - chartTitleHeight) / 2), 0))


.ChartTitle.Left = chartAreaWidth
chartTitleWidth = (.ChartArea.Width - ChartTitle.Left)
.ChartTitle.Left = .Axes(xlValue).Left + Round(((plotAreaWidth + plotAreaLeft - .Axes(xlValue) _
.Left - chartTitleWidth) / 2), 0)
End With

ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
ActiveSheet.Paste
Selection.ShapeRange.Top = thisObjectTop
Selection.ShapeRange.Left = thisObjectLeft

'This above statements results in a marginally smaller picture and stuffs up the Custom Printing
' that I have written for the sheet that has loads of graph on it.

myDocument.ChartObjects(wrkg1).Select
Selection.Delete
thisSheetChartCount = thisSheetChartCount - 1
Loop
End Sub
[/vba] Any suggestions on this please!

Best regards


Deepak

[Andy Pope]

If you want the size the same then xlBitmap instead of xlPicture. But this will affect the quality and appearence.

The work around for width and height is not new. You can find posts about it as far back as 2002.

[alexgiurca]

Hello!

Please try this:

[VBA]Dim sqlcon As String
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Dim crow As Integer
Set con = New ADODB.Connection
Set rs = New ADODB.Recordset
On Error GoTo Except
Set con = New ADODB.Connection
con.Provider = "Microsoft.Jet.OLEDB.4.0"
con.ConnectionString = "data source=C:\Documents and Settings\x01020750\My Documents\YOUR.mdb"
con.Mode = adModeReadWrite
con.Open
MsgBox "Connected via " & con.Provider & " OLE DB Provider!", vbInformation
Except:
MsgBox Err.Description, vbCritical
For Each sho In xlsht.Shapes
'because we have stored the number of the EXCEL row in the access table
'on our first run, now we know which row of the table needs to
' be update. So we will get the SHAPE row and launch a SELECT query to
' determine the correspondent row in the ACCESS database.
crow = sho.TopLeftCell.Row
sqlcon = "SELECT * FROM reportfc WHERE imgr=" & crow
rs.Open sqlcon, con, adOpenKeyset, adLockOptimistic
rs.Update
If Not SaveObjectPictureToFile(sho, "C:\Data_Local\" + sho.Name + ".bmp") Then
MsgBox "Picture was not saved!"
End If
FileToBlob "C:\Data_Local\" + sho.Name + ".bmp", rs!file, 16384
' we need rs!image to keep track of access table rows that have a
' value in the OLE OBJECT column. Otherwise we will get some weird
' errors if we do something like IF ISNULL(rs!file) then ... when
' we try to export the data back to excel and we obviously need to
' know if we have (or not) a picture in the table row.
rs!imge = 1
' we keep track of shape Height and Width (with export in mind)
rs!imgh = sho.Height
rs!imgw = sho.Width
rs.Update
rs.Close
Next sho
con.Close
MsgBox ("The import of data from EXCEL has been completed!")[/VBA]

Basically you have to do the following:
1. create two arrays (or a database table in access to store the picture/chart/OLE Object height, size and width).
2. go through each OLE object in your active sheet. read & store information on size, height and width.
3. export / import the OLE object from/to Excel as many time as you want.
Afterwards you can apply transformation on size, height and width values at your discretion.

I have attached a full working example on thread:
http://www.vbaexpress.com/forum/showthread.php?t=25157

Albeit in my example I used pictures, it will work for any OLE Object.

Regards,
Alex