VB.Net VSTO PowerPoint Addin - PullRequest
       29

VB.Net VSTO PowerPoint Addin

0 голосов
/ 21 января 2019

Я делаю надстройку для PowerPoint 2013. Моя цель - преобразовать все уравнения, найденные на слайдах, в обычный текст, чтобы изменить шрифт этих уравнений. Потому что это не позволит мне изменить шрифт, пока они являются уравнениями. Мне удалось найти уравнения, перебирая текстовые диапазоны и находя название шрифта, они используют «Cambria Math». Итак, мой вопрос: как программно изменить уравнения в обычный текст, как это делает кнопка в инструментах уравнений? И кажется, по какой-то причине они удалили «макрос записи» из PowerPoint, поэтому я не мог получить помощь от этого. Я попытался записать макрос в слове и сделал то же самое, и я получил: Selection.OMaths(1).ConvertToMathText, но в PowerPoint это не похоже на OMath.

Dim Application As PowerPoint.Application = New PowerPoint.Application
        Dim Presentation As PowerPoint.Presentation = Application.ActivePresentation
        Dim Windows As PowerPoint.DocumentWindows = Application.Windows

        For Each Slide As PowerPoint.Slide In Presentation.Slides
            For Each Shape As PowerPoint.Shape In Slide.Shapes
                For Each Paragraph As PowerPoint.TextRange In Shape.TextFrame.TextRange
                    For Each Line As PowerPoint.TextRange In Paragraph.Lines
                        If Line.Font.Name = "Cambria Math" Then
                            With Line.Font
                                .Name = "Calibri"
                                .Bold = True
                            End With
                        ElseIf Line.Font.Name = "Calibri" Then
                            With Line.Font
                                .Name = "Palatino"
                            End With
                        End If
                    Next Line
                Next Paragraph
            Next Shape
            Next Slide
    End Sub

Другой текст здесь обычно изменяется, но уравнения с шрифтом "Math Cambria" остаются без изменений.

Я также пытался получить выделение, затем что-то с OMaths, как в Word Vsto, но, похоже, OMaths не является частью PowerPoint. Этот следующий код на самом деле должен заменить его на уравнение, но я думаю, если бы он работал, мог бы найти способ обратить его вспять.

For Each Window As PowerPoint.DocumentWindow In Windows
    Selection.OMaths(1).ConvertToMathText
Next Window

1 Ответ

0 голосов
/ 23 января 2019

Я получил его для работы с PowerPoint 2016 в VBA. У меня не было «Calibri» в моем списке шрифтов, поэтому я изменил его на «Calibri (Body)», и он работает. Это может быть та же проблема, что и у вас с .NET VSTO Addin. Если у меня будет время, я соберу пример дополнения VSTO и также опубликую результаты.

Видео

video

Код VBA

Public Sub UpdateShapeFont()
On Error GoTo ErrTrap
Dim Application     As PowerPoint.Application: Set Application = New PowerPoint.Application
Dim Presentation    As PowerPoint.Presentation: Set Presentation = Application.ActivePresentation
Dim Windows         As PowerPoint.DocumentWindows: Set Windows = Application.Windows
Dim Slide           As PowerPoint.Slide
Dim Shape           As PowerPoint.Shape
Dim Paragraph       As PowerPoint.TextRange
Dim line            As PowerPoint.TextRange

    For Each Slide In Presentation.Slides
        For Each Shape In Slide.Shapes
            For Each Paragraph In Shape.TextFrame.TextRange
                For Each line In Paragraph.Lines
                    Select Case line.Font.Name
                        Case "Cambria Math"
                            With line.Font
                                .Name = "Calibri (Body)" 'check if the font exists in your list of fonts; it did not work for "Calibri"
                                .Bold = True
                            End With
                        Case "Calibri"
                            With line.Font
                                .Name = "Palatino"
                            End With
                    End Select
                Next line
            Next Paragraph
        Next Shape
    Next Slide

ExitProcedure:
    On Error Resume Next
    Exit Sub

ErrTrap:
    Select Case Err.number
        Case Else
            Debug.Print "Error #: " & Err.number & " |Error Description: " & Err.description
    End Select
    Resume ExitProcedure
    Resume 'for debugging

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...