Как сохранить исходное форматирование текста перед запуском VBA?

У меня есть код, который переключает цвет шрифта выбранного текста с помощью заранее определенных цветов (черный> красный> зеленый> черный и т. д.). Что я действительно хотел бы сделать, так это сделать его более динамичным для любого форматирования, в котором уже находится моя презентация.

Например, если я запускаю макрос для части заголовка слайда, отформатированного как синий, у меня нет хорошего способа вернуться к исходному синему цвету. Я думал о «копировании» форматирования в какую-то переменную, но я не уверен, как точно очистить переменную или сохранить ее на потом.

Что кажется более вероятным, так это создание своего рода «контекстного» поиска. Если я могу посмотреть слева и справа от выделенного текста, может быть некоторая информация о том, каким должен быть цвет текста (поскольку он очень редко должен отличаться в текстовом блоке). Но это быстро выходит за рамки моего ноу-хау.

См. код ниже для текущей настройки.

Sub TextColorSwap()

On Error Resume Next

With ActiveWindow.Selection
    If .TextRange.Font.Color = RGB(0, 0, 0) Then
        .TextRange.Font.Color = vbRed
    ElseIf .TextRange.Font.Color = vbRed Then
        .TextRange.Font.Color = RGB(0, 153, 0)
    Else
        .TextRange.Font.Color = RGB(0, 0, 0)
    End If
End With

End Sub

Есть мысли от профи?

-R


vba powerpoint
person randall13    schedule 31.10.2016    source источник

Ответы (1)


arrow_upward
0
arrow_downward

Как насчет чего-то вроде этого, чтобы вы начали:

Option Explicit

Public bFirstColour As Boolean

Sub TextColorSwap()

  ' This will mask all errors, and if you don't have your own error handler,
  ' is bad practice as you'll never know if something's gone wrong.
  On Error Resume Next

  Dim lColour As Long
  Dim lCursor As Long

  With ActiveWindow.Selection

    If .Type = ppSelectionText Then
      ' Get the start position of the selected text
      lCursor = .TextRange.Start
      ' If there are characters to the left of the selected text, save the colour and set a flag
      If lCursor > 1 And Not bFirstColour Then
        lColour = .TextRange.Characters(1).Font.Color
        bFirstColour = True
      End If
      ' Toggle the colour
      With .TextRange.Font
        If .Color = lColour Then
          .Color = vbRed
        ElseIf .Color = vbRed Then
          .Color = RGB(0, 153, 0)
        Else
          ' Reset the colour to the colour fond to the left of the text
          .Color = lColour
          bFirstColour = False
        End If
      End With
    End If
  End With
End Sub
person Jamie Garroch - MVP    schedule 31.10.2016