How to obtain which part of chart is selected? - vsto

Question

I have some vsto add-in to PowerPoint.
I need to know which part of chart is selected by user (series, title, charta area, plot area, legend etc.). Is it possible to get such information?
I know, of course, how to get selected chart.

Answer 1

My add-in is written in VBA, but I think the below will help you. The PPT object model doesn't support this, so my hacky solution was to apply Strikethrough font as an ExecuteMSO command (i.e., Strikethrough is applied to whatever is selected), then I go through every element of the chart and look for Strikethrough. When we find it, we can tell what the user had selected, apply whatever rules we want, and remove the Strikethrough.
In my case, I wanted to rewrite the Bold command so that we could apply a different font weight to the user's selection, rather than using the native faux-bolding. Here is part of my solution:
First, this is the sub that's called when the selection contains shapes. Note how we handle the chart scenario:
Private Sub commandBoldSelectedShapes(mySelection As Selection)
Debug.Print "IN_commandBoldSelectedShapes"
Dim oShp As Shape
Dim oSmrtArt As SmartArt
Dim oTable As Table
Dim oChart As Chart
Dim oCell As Cell
Dim i As Long
Dim j As Long
Dim ctr As Long
Dim oFont As Font
For ctr = 1 To mySelection.ShapeRange.Count
Set oShp = mySelection.ShapeRange(ctr)
If oShp.Type = msoGroup Then
RefontTypoGroup oShp, mySelection
ElseIf oShp.HasSmartArt Then
Set oSmrtArt = oShp.SmartArt
DoEvents
Application.CommandBars.ExecuteMso ("Strikethrough")
DoEvents
RefontTypoSmartArt oSmrtArt
ElseIf oShp.HasTable Then
Debug.Print "Seeing a table!"
Set oTable = oShp.Table
If ctr = 1 And mySelection.ShapeRange.Count = 1 Then
With oTable
For i = 1 To oTable.Rows.Count
For j = 1 To oTable.Columns.Count
Set oCell = oTable.Rows(i).Cells(j)
If oCell.Selected Then
Set oFont = oCell.Shape.TextFrame.TextRange.Font
checkBoldsNoStrikethrough oFont
End If
Next
Next
End With
Else
For i = 1 To oTable.Rows.Count
For j = 1 To oTable.Columns.Count
Set oCell = oTable.Rows(i).Cells(j)
Set oFont = oCell.Shape.TextFrame.TextRange.Font
checkBoldsNoStrikethrough oFont
Next
Next
End If
' Charts are highly problematic because the VBA Selection object
' doesn't allow you to figure out which element(s) in a chart the user
' may have selected. You can only see that the full shape containing a chart
' has been selected. So my solution was to run an
' ExecuteMso - Strikethrough command. Then, separate macros
' go through the whole chart looking for strikethoughs and replace them
' with bolded/unbolded text and the correct font weight.
ElseIf oShp.HasChart Then
Debug.Print "Seeing a chart!"
Set oChart = oShp.Chart
If ctr = 1 And mySelection.ShapeRange.Count = 1 Then
DoEvents
Application.CommandBars.ExecuteMso ("Strikethrough")
DoEvents
RefontTypoChart oChart
Exit Sub
' If there is more than one shape selected, including a chart,
' and that chart is not the first shape selected, we know that
' the whole chart has been selected. As a result, we can simply
' apply bolding to the whole chart.
Else
With oChart.ChartArea.Format.TextFrame2.TextRange.Font
If GlobalSettings.IsBoldPressed = False Then
.Bold = False
.Name = FontsSettings.ActiveFonts.bodyFont
Else
.Bold = True
.Name = FontsSettings.ActiveFonts.headingFont
End If
End With
End If
ElseIf oShp.HasTextFrame Then
If oShp.TextFrame.HasText Then
Set oFont = oShp.TextFrame.TextRange.Font
checkBoldsNoStrikethrough oFont
End If
End If
Next
End Sub
And there is the sub that starts going through the chart elements. Most checks are outsourcing the Strikethrough hunt to yet another sub:
Sub RefontTypoChart(chrt As Chart)
On Error GoTo Errhandler
' Dim s As Series
Dim A As axis
' Dim scnt As Integer
Dim i As Integer
Dim oShp As Shape
Dim oTxtRange2 As TextRange2
Dim oTickLabels As TickLabels
Dim oLegendEntries As LegendEntries
Set oTxtRange2 = chrt.Format.TextFrame2.TextRange
If oTxtRange2.Font.Strikethrough = msoTrue Then
RefontTypoChartShapeRange oTxtRange2
Exit Sub
End If
If chrt.HasLegend Then
Set oLegendEntries = chrt.Legend.LegendEntries
For i = 1 To oLegendEntries.Count
With oLegendEntries(i).Font
If GlobalSettings.IsBoldPressed = False Then
If .Strikethrough = True Then
.Bold = False
.Name = FontsSettings.ActiveFonts.bodyFont
.Strikethrough = False
End If
Else
If .Strikethrough = True Then
.Bold = True
.Name = FontsSettings.ActiveFonts.headingFont
.Strikethrough = False
End If
End If
End With
Next
With chrt.Legend.Format.TextFrame2.TextRange.Font
If GlobalSettings.IsBoldPressed = False Then
If .Strikethrough = True Then
.Bold = False
.Name = FontsSettings.ActiveFonts.bodyFont
.Strikethrough = False
End If
Else
If .Strikethrough = True Then
.Bold = True
.Name = FontsSettings.ActiveFonts.headingFont
.Strikethrough = False
End If
End If
End With
End If
If chrt.HasTitle Then
Set oTxtRange2 = chrt.ChartTitle.Format.TextFrame2.TextRange
RefontTypoShapeRange oTxtRange2
End If
If chrt.HasAxis(xlCategory, xlPrimary) Then
Set A = chrt.Axes(xlCategory, xlPrimary)
If A.HasTitle = True Then
Set oTxtRange2 = A.AxisTitle.Format.TextFrame2.TextRange
RefontTypoShapeRange oTxtRange2
End If
Set oTickLabels = A.TickLabels
RefontTypoTickLabels oTickLabels
End If
If chrt.HasAxis(xlCategory, xlSecondary) Then
Set A = chrt.Axes(xlCategory, xlSecondary)
If A.HasTitle = True Then
Set oTxtRange2 = A.AxisTitle.Format.TextFrame2.TextRange
RefontTypoShapeRange oTxtRange2
End If
Set oTickLabels = A.TickLabels
RefontTypoTickLabels oTickLabels
End If
If chrt.HasAxis(xlValue, xlPrimary) Then
Set A = chrt.Axes(xlValue, xlPrimary)
If A.HasTitle = True Then
Set oTxtRange2 = A.AxisTitle.Format.TextFrame2.TextRange
RefontTypoShapeRange oTxtRange2
End If
Set oTickLabels = A.TickLabels
RefontTypoTickLabels oTickLabels
End If
If chrt.HasAxis(xlValue, xlSecondary) Then
Set A = chrt.Axes(xlValue, xlSecondary)
If A.HasTitle = True Then
Set oTxtRange2 = A.AxisTitle.Format.TextFrame2.TextRange
RefontTypoShapeRange oTxtRange2
End If
Set oTickLabels = A.TickLabels
RefontTypoTickLabels oTickLabels
End If
RefontTypoChartLabels chrt
If chrt.Shapes.Count > 0 Then
For Each oShp In chrt.Shapes
If oShp.HasTextFrame Then
If oShp.TextFrame.HasText Then
Set oTxtRange2 = oShp.TextFrame2.TextRange
RefontTypoShapeRange oTxtRange2
End If
End If
Next
End If
Exit Sub
Errhandler:
Debug.Print "Error: " & Err.Description
End Sub
Here is the sub that looks for most of the Strikethroughs:
Public Sub RefontTypoShapeRange(oTxtRange2 As TextRange2)
Dim i As Long
With oTxtRange2
For i = .Runs.Count To 1 Step -1
With .Runs(i).Font
If GlobalSettings.IsBoldPressed = False Then
If .Strikethrough = True Then
.Bold = False
.Name = FontsSettings.ActiveFonts.bodyFont
End If
Else
If .Strikethrough = True Then
.Bold = True
.Name = FontsSettings.ActiveFonts.headingFont
End If
End If
End With
Next
.Font.Strikethrough = False
End With
End Sub
You may notice that in the second sub posted, there are references to a few different subs that are specialized for certain chart elements. This is because TickLabels don't have a TextRange2 object and therefore need their own checker sub (one which passes along a TickLabels object). Also, there's a distinction made between chart elements that can have more than one formatting Run, and those that can't -- looking for Runs in the TextRange2 object of chart elements that don't support more than 1 run will cause a crash.
Public Sub RefontTypoChartShapeRange(oTxtRange2 As TextRange2)
Debug.Print "IN_RefontTypoChartShapeRange"
With oTxtRange2.Font
If GlobalSettings.IsBoldPressed = False Then
If .Strikethrough <> msoFalse Then
.Bold = False
.Name = FontsSettings.ActiveFonts.bodyFont
End If
Else
If .Strikethrough <> msoFalse Then
.Bold = True
.Name = FontsSettings.ActiveFonts.headingFont
End If
End If
.Strikethrough = False
End With
End Sub
Chart data labels are a small nightmare too, as they will become disconnected from the data if we don't massage the .Autotext property as seen below.
Sub RefontTypoChartLabels(oChrt As Chart)
Dim i As Integer
Dim j As Integer
Dim seriesVar As Series
Dim dataLabelsVar As DataLabels
Dim dataLabelVar As DataLabel
Dim pointVar As Point
Dim oTxtRange2 As TextRange2
Dim isAutoText As Boolean
For i = 1 To oChrt.SeriesCollection.Count
Set seriesVar = oChrt.SeriesCollection(i)
If seriesVar.HasDataLabels = True Then
Set dataLabelsVar = seriesVar.DataLabels
If dataLabelsVar.Format.TextFrame2.TextRange.Font.Strikethrough <> msoFalse Then
Set oTxtRange2 = dataLabelsVar.Format.TextFrame2.TextRange
RefontTypoChartShapeRange oTxtRange2
Else
For j = 1 To seriesVar.Points.Count
Set pointVar = seriesVar.Points(j)
If pointVar.HasDataLabel = True Then
Set dataLabelVar = seriesVar.DataLabels(j)
isAutoText = dataLabelVar.AutoText
Set oTxtRange2 = dataLabelVar.Format.TextFrame2.TextRange
RefontTypoChartShapeRange oTxtRange2
dataLabelVar.AutoText = isAutoText
End If
Next
End If
End If
Next
End Sub
Hopefully you're able to adapt some of this to your needs and avoid pulling out your hair. You can also use Shadow instead of Strikethrough if you think someone somewhere might need to use Strikethrough font inside a chart.

Answer 2

The PowerPoint object model doesn't provide any property or method for that.