粘贴特殊msoClipboardFormatPlainText在Mac上创建不需要的换行符

问题描述

我也在尝试使Mac版PowerPoint的vba宏也能正常工作。它们很多,但在这里或那里几乎没有什么错。

一个宏用于将文本从一个选定的形状复制到其他选定的形状而无需格式化。

我用

.TextFrame2.TextRange.PasteSpecial msoClipboardFormatPlainText

宏在Windows机器上的工作方式与在Mac上一样,只有一个小问题:在目标形状的文本末尾创建了不必要的换行符。有谁知道避免这种情况的方法

该选项

.TextFrame2.TextRange.PasteSpecial msoClipboardFormatRTF

不会创建此中断,但会保留源形状的字体颜色,并且与

相同
.TextFrame2.TextRange.PasteSpecial msoClipboardFormatNative

保留源形状的字体颜色和字体大小。目前,PlainText选项最接近我的目标。但是我当然希望我能有一个完美的解决方案。

任何提示都值得赞赏。谢谢!

编辑:这是完整的代码。在John的建议之后,我添加了以.text开头的Line,但在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

解决方法

您正在macOS和Windows中看到不同行尾的影响。 Windows使用回车符和换行符(在VBA中为vbCrLf),而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中的操作,因为不会在其中创建双精度返回。