Блог

Я пытаюсь заставить свои макросы vba для PowerPoint работать и на Mac. Многие из них делают это, но здесь или там что-то идет не так.

Один макрос предназначен для копирования текста из одной выбранной фигуры в другие выбранные фигуры без форматирования.

Я использую

 .TextFrame2.TextRange.PasteSpecial msoClipboardFormatPlainText
  

Макрос работает так, как должен на компьютерах с Windows, и так же работает на Mac, только с одной маленькой проблемой: он создает нежелательный разрыв строки в конце текста в целевых фигурах. Кто-нибудь знает способ избежать этого?

Опция

 .TextFrame2.TextRange.PasteSpecial msoClipboardFormatRTF
  

не создает этот разрыв, но сохраняет цвет шрифта исходной формы и такой же, чтобы

 .TextFrame2.TextRange.PasteSpecial msoClipboardFormatNative
  

который сохраняет цвет шрифта и размер шрифта исходной формы. Опция открытого текста наиболее близка к моей цели на данный момент. Но, конечно, я хотел бы иметь идеальное решение.

Приветствуется любая подсказка. Спасибо!

Редактировать: это полный код. После предложения Джона я добавил строку, начинающуюся с .text , но это не имело никакого значения на моем Mac.

 Sub DubTextOnly()

    Dim shp As Shape
    Dim shp1 As Shape
    Dim i As Integer

    On Error GoTo err

    If ActiveWindow.Selection.ShapeRange.Count < 2 Then
        MsgBox "Please select at least two shapes (no tables)"
        Exit Sub
    End If
    
Set shp1 = ActiveWindow.Selection.ShapeRange(1)

shp1.TextFrame2.TextRange.Copy
DoEvents
shp1.Tags.Add "Deselect", "yes"

    For Each shp In ActiveWindow.Selection.ShapeRange
        If shp.Tags("Deselect") = "yes" Then
        Else
        With shp
        With .TextFrame
            For i = 1 To 9
            With .Ruler
                .Levels(i).FirstMargin = 0
                .Levels(i).LeftMargin = 0
            End With
            Next
            End With
            With .TextFrame2
            With .TextRange
                .ParagraphFormat.Bullet.Type = ppBulletNone
                .PasteSpecial msoClipboardFormatPlainText
                .Text = Replace(.Text, vbCr amp; vbCr, vbCr)
            End With
        End With
        End With
        DoEvents
        End If
    Next shp
    For Each shp In ActiveWindow.Selection.ShapeRange
        If shp.Tags("Deselect") = "yes" Then
        shp.Tags.Delete "Deselect"
        End If
    Next shp
    Exit Sub
    
err:
    MsgBox "Please select at least two shapes (no tables)"
    
End Sub
  

Вы видите эффект разных окончаний строк в macOS и Windows. Windows использует возврат каретки плюс перевод строки ( vbCrLf в VBA), в то время как macOS использует только перевод строки vbLf . При вставке в PowerPoint программа переводит оба символа в отдельные абзацы, при этом второй символ остается пустым.

Попробуйте этот код:

 Sub PasteTest()
    With ActivePresentation.Slides(1).Shapes(1).TextFrame2.TextRange
        .PasteSpecial msoClipboardFormatPlainText
        .Text = Replace(.Text, vbCr amp; vbCr, vbCr)
    End With
End Sub
  

Это не должно влиять на операции в Windows, поскольку двойные возвраты там не создаются.