Search code examples
vstopowerpointoffice-interop

How to obtain which part of chart is selected?

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.

Solution

  • 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.