vba - PPT中可以使用VBA代码从剪贴板粘贴到PNG吗？

Question

我已经尝试了许多版本来获取此代码。这至少出错了...我想在 PowerPoint 中，从剪贴板选择性粘贴到 PNG。

Sub Test()
ActivePresentation.Slides.Paste.Shapes.PasteSpecial ppPastePNG

End Sub

这个错误出来说

“请求无效。剪贴板为空或包含可能无法粘贴到此处的数据。”

剪贴板不是空的，并且包含我可以粘贴的数据。

感谢您的任何想法！

Answer 1

仅供参考 - 经过多次试验和错误，我想出了这个宏。它复制幻灯片内容并将其以 PNG 格式粘贴回幻灯片。

Sub test()
Dim sld As Slide
Dim pre As Presentation
Dim shp1 As Shape
Dim shp2 As Shape


Set pre = ActivePresentation

For Each sld In pre.Slides
    Set shp1 = sld.Shapes.AddShape(msoShapeRectangle, 0, 0, 20, 20)
    shp1.Line.Visible = msoFalse
    shp1.Fill.Transparency = 1

Set shp2 = sld.Shapes.AddShape(msoShapeRectangle, 0, 0, 20, 20)
shp2.Left = 720 - shp2.Width
shp2.Top = 540 - shp2.Width
shp2.Line.Visible = msoFalse
shp2.Fill.Transparency = 1
Next

For Each sld In pre.Slides
     sld.Shapes.Range.Cut

If sld.Shapes.Count > 0 Then
   sld.Shapes.Range.Delete
   sld.Shapes.PasteSpecial ppPastePNG
   sld.Shapes.Range.Align msoAlignCenters, msoTrue
   sld.Shapes.Range.Align msoAlignMiddles, msoTrue
End If

If sld.Shapes.Count = 0 Then
sld.Shapes.PasteSpecial ppPastePNG
sld.Shapes.Range.Align msoAlignCenters, msoTrue
sld.Shapes.Range.Align msoAlignMiddles, msoTrue
End If
Next

End Sub

Answer 2

简单的回答：

Set m = ActivePresentation
n = m.Slides.Count
m.Slides.Add n + 1, ppLayoutBlank
m.Slides(2).Shapes.PasteSpecial ppPastePng

PowerPoint 上的 msdn 参考页：
“形状”粘贴格式： http:
//msdn.microsoft.com/en-us/library/office/ff745158 (v=office.15).aspx

新幻灯片版式： http:
//msdn.microsoft.com/en-us/library/office/ff745137 (v=office.15).aspx

或者，如果需要纯文本：

m.Slides.Add n + 1, ppLayoutText
m.Slides(n + 1).Shapes(2).TextFrame.TextRange.PasteSpecial (ppPasteText)

“textrange”粘贴特殊格式： http:
//msdn.microsoft.com/en-us/library/office/ff745706 (v=office.15).aspx

甚至将文本放入变量中：

 myVar = m.Slides(1).Shapes(1).TextFrame.TextRange.Text

“textrange”文本属性： http:
//msdn.microsoft.com/en-us/library/office/ff746239 (v=office.15).aspx

PS
小写也可以用于属性或方法，尽管它们在文档中都是大写字母。
函数调用的括号可以省略，如上面的第一个代码块。