0

我也在尝试让我的用于 PowerPoint 的 vba 宏也可以在 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 & 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
4

1 回答 1

0

您将看到 macOS 和 Windows 中不同行尾的效果。Windows 使用回车加换行符（vbCrLf在 VBA 中），而 macOS 仅使用换行符vbLf。当您粘贴到 PowerPoint 中时，程序会将两个字符转换为单独的段落，而第二个为空。

试试这个代码：

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

它不应该影响 Windows 中的操作，因为那里没有创建双重返回。

于 2020-10-20T17:08:54.713 回答