文字和嵌入式图形混排“串”无变形粘贴到PPT

把以下代码复制到VBA的模块中,选择需要复制的内容,然后执行宏CopySelectFormula2PPT,就会按你的需要产生一个已经复制好内容的PPT.

Sub CopySelectFormula2PPT()
Dim PPTapp As Object, myPPT As Object, mySlide As Object
Dim x As Object
Dim y As Object
Dim z As Object
Selection.CopyAsPicture
Set PPTapp = CreateObject("PowerPoint.Application")
PPTapp.Visible = True
Set myPPT = PPTapp.Presentations.Add(msoTrue)
Set mySlide = myPPT.slides.Add(1, 12)
With mySlide
    Set x = .Shapes.PasteSpecial(2)
    x.Left = 100: x.Top = 200
    Set y = x.Ungroup
    Set z = y.Ungroup
    z(1).Delete
End With
PPTapp.Activate
Set z = Nothing
Set y = Nothing
Set x = Nothing
Set mySlide = Nothing
Set myPPT = Nothing
Set PPTapp = Nothing
End Sub

谢谢lwxg兄。
代码对对象的处理“原汤原汁”，非常好。
但是，我的意思没有说清楚，得寸进尺了。烦请老兄和各位继续援手：
①我是要在当前打开的PPT文档中的当前页面位置粘贴一个内容，不是新建一个PPT文档，能否实现？
②现在得到的PPT文档中的内容并未“组合”，能否组合？
③现在得到的内容中，上下标是用字号不同的文字实现的，能否用真正的上下标？(这个若不能实现就算了)
④能否将选中内容中连续的所有文本(含中英文)放入一个文本框中(现在是中英文分开处理、角标分开处理)？
⑤这样得到的内容在PPT中组合后缩放时，文字大小位置不成比例，但若组合、复制、选择性粘贴为增强图元文件，则可以“等比例缩放”(若要编辑，只需编辑图片即可)。能否处理？
⑥第二个苯环为何不清晰？
总之，我需要用两种方式处理：
方式一：在PPT编辑环境下，运行一个宏，则调用Word，在Word中输入化学方程式，运行一个宏，按上述要求处理，将结果放在剪贴板中，自动退出Word回到PPT,并将结果粘贴在PPT中(一些处理如上述⑤可在PPT的宏中进行)。
方式二：在Word编辑环境中，输入化学方程式，用宏自动处理，剪切到剪贴板中即可(在PPT中手工粘贴)。
具体示例见附件。

F02BxJxg.rar (23.48 KB)
下载次数: 6

2007-5-20 08:31

[此贴子已经被作者于2007-5-20 8:31:59编辑过]

按照3楼方式一中的意思，在WORD里运行宏COPY2PPT，会自动把你选择的一行（目前只支持一行）文本或嵌入式图形COPY之后，在当前打开的PPT文件的当前页上，以增强型图元文件粘贴。粘贴后自动激活PPT窗口。

Sub Copy2PPT()
On Error Resume Next

    If Selection.Type <> wdSelectionNormal Then
        MsgBox "请先选择要导出的内容。仅支持嵌入式图形和文本。"
        Exit Sub
    End If

    oldPageWidth = Selection.PageSetup.PageWidth
   
    Selection.EndKey Unit:=wdLine
    rightPos = Selection.Information(wdHorizontalPositionRelativeToPage)
   
    newPageWidth = rightPos + Selection.PageSetup.RightMargin + 2
   
    Selection.PageSetup.PageWidth = newPageWidth
    Application.ScreenRefresh
    Selection.Paragraphs(1).Range.Select
    Selection.Copy
   
    Dim PPTapp As Object, mySlide As Object
    Dim x As Object
   
    Err.Clear
    Set PPTapp = GetObject(, "PowerPoint.Application")
   
    If Err.Number > 0 Then
        MsgBox "没有打开的PPT文件。"
        Selection.PageSetup.PageWidth = oldPageWidth
        Exit Sub
    End If
   
    Set mySlide = PPTapp.ActiveWindow.View.Slide
   
    With mySlide
        Set x = .Shapes.PasteSpecial(2)
        x.Left = 100: x.Top = 100
    End With
   
    Selection.PageSetup.PageWidth = oldPageWidth
    PPTapp.Activate
    Set x = Nothing
    Set mySlide = Nothing
    Set PPTapp = Nothing
   
End Sub

如果同时打开了多个PPT文件，程序会自动把图形贴到最后编辑的PPT页面中。

[此贴子已经被作者于2007-5-20 17:15:40编辑过]

在powerpoint中用选择性粘贴，选择粘贴为word对象！

to csnAlex，谢谢，很好用。
只能一行——对我没影响。
在Word中修改更方便——当然。但是，可能有时在PPT中也要修改。其实在PPT中修改有不利的地方，只要取消组合了，可缩放时文字不能放大。、

to cuteword
“在powerpoint中用选择性粘贴，选择粘贴为word对象”——此时，图片与Word页面等宽，后面是空白。

在word中调整好格式，适应于ppt中的长度和宽度，在ppt中也可以调整，我自己经常这样干