Моя надстройка написана на VBA, но я думаю, что приведенное ниже вам поможет. Объектная модель PPT не поддерживает это, поэтому моим хакерским решением было применить шрифт Strikethrough как команду ExecuteMSO (т.е. Strikethrough применяется ко всему, что выбрано), затем I go через каждый элемент диаграммы и искать Strikethrough . Когда мы его находим, мы можем сказать, что выбрал пользователь, применить любые правила, которые мы хотим, и удалить зачеркнутый.
В моем случае я хотел переписать команду Bold, чтобы мы могли применить другой шрифт вес по выбору пользователя, а не с использованием собственного искусственного выделения жирным шрифтом. Вот часть моего решения:
Во-первых, это вспомогательная функция, которая вызывается, когда выделение содержит фигуры. Обратите внимание, как мы обрабатываем сценарий диаграммы:
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
И есть подпрограмма, которая начинает проходить через элементы диаграммы. Большинство проверок передают поиск зачеркивания на аутсорсинг еще одной подпрограмме. опубликованы ссылки на несколько различных подпрограмм, которые предназначены для определенных элементов диаграммы. Это связано с тем, что TickLabels не имеет объекта TextRange2 и, следовательно, нуждается в своей собственной подпрограмме проверки (которая передает объект TickLabels). Кроме того, существует различие между элементами диаграммы, которые могут иметь более одного прогона форматирования, и теми, которые не могут - поиск Runs в объекте TextRange2 элементов диаграммы, которые не поддерживают более одного прогона, вызовет крах sh.
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
Ярлыки данных диаграммы также представляют собой небольшой кошмар, поскольку они будут отключены от данных, если мы не будем массировать свойство .Autotext, как показано ниже.
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
Надеюсь, вы сможете приспособить некоторые из них к своим потребностям и не выдергивать волосы. Вы также можете использовать Shadow вместо Strikethrough, если считаете, что кому-то где-то может понадобиться использовать Strikethrough шрифт внутри диаграммы.