问题描述
我也在尝试使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中的操作,因为不会在其中创建双精度返回。