Question

我有一个excel工作簿，它充当仪表板并运行代码以使用一个表打开多个word文件，复制表，然后将其粘贴到电源点中的特定幻灯片。

我试图找出如何从word复制表并将其粘贴在power point作为增强型图元文件图片。到目前为止，当我有我的代码时，我在pastespecial代码上得到一个错误（对象不支持此方法）：

word_1.tables(1).Range.Copy
PP.slides(destination_1).Shapes.PasteSpecial(ppPasteEnhancedMetafile)

现在我正在考虑将图像首先粘贴到excel中的备用表中，然后将其复制并再次粘贴到电源点。我想避免这一步。

有没有人知道如何将表格作为图片（增强型图元文件）从单词粘贴到简报？

我的完整代码如下：

Sub Debates_to_PP()
Dim destination_1 As Long
Dim objWord As Object

Set wb1 = ActiveWorkbook

'set slide destinations --- (needs to be a loop)
destination_1 = wb1.Sheets("Dash").Cells(12, 8).Value


'get path for PP
PPPath_name = wb1.Sheets("Dash").Cells(4, 10).Value
PPfile_name = wb1.Sheets("Dash").Cells(4, 11).Value

'Combine File Path names
PPfiletoopen = PPPath_name & "\" & PPfile_name

'Get path
Path_name = wb1.Sheets("Dash").Cells(12, 10).Value
file_name = wb1.Sheets("Dash").Cells(12, 11).Value

'Combine File Path names
filetoopen = Path_name & "\" & file_name

'Browse for a file to be open
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Set word_1 = objWord.Documents.Open(filetoopen)

'open power point---------------------------------------------------------------------
Dim objPPT As Object

Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True

'Open PP file
objPPT.Presentations.Open Filename:=PPfiletoopen
Set PP = objPPT.activepresentation

'Copy and paste table-----------------------------------------------------------------
word_1.tables(1).Range.Copy
With PP.slides(destination_1).Shapes.PasteSpecial(ppPasteEnhancedMetafile)
     .Top = 100  'desired top position
     .Left = 20  'desired left position
     .Width = 650
End With



PP.Save

PP.Close


word_1.Close



End Sub

更新＃1

更新了代码来解决这个问题...但它的速度很慢：

Sub Debates_to_PP()
Dim destination_1 As Long
Dim objWord As Object

Set wb1 = ActiveWorkbook

'get path for PP
PPPath_name = wb1.Sheets("Dash").Cells(4, 10).Value
PPfile_name = wb1.Sheets("Dash").Cells(4, 11).Value

'Combine File Path names for PP
PPfiletoopen = PPPath_name & "\" & PPfile_name

'open power point---------------------------------------------------------------------
Dim objPPT As Object

Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True

'Open PP file
objPPT.Presentations.Open Filename:=PPfiletoopen
Set PP = objPPT.activepresentation



'Start loop for Word Debate Files------------------------------------------------------
For i = 1 To 20

'Check if slide destination is identified
If IsNumeric(wb1.Sheets("Dash").Cells(11 + i, 8).Value) <> True Then GoTo here

'set slide destinations
destination_1 = wb1.Sheets("Dash").Cells(11 + i, 8).Value


'Get path
Path_name = wb1.Sheets("Dash").Cells(11 + i, 10).Value
file_name = wb1.Sheets("Dash").Cells(11 + i, 11).Value

'Combine File Path names
filetoopen = Path_name & "\" & file_name

'Browse for a file to be open
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Set word_1 = objWord.Documents.Open(filetoopen)

'Copy and paste table-----------------------------------------------------------------
word_1.tables(1).Range.Copy
wb1.Worksheets("Place_Holder").Activate
wb1.Worksheets("Place_Holder").PasteSpecial Format:="Picture (Enhanced Metafile)", _
    Link:=False, DisplayAsIcon:=False

wb1.Sheets("Place_Holder").Shapes(1).CopyPicture
With PP.slides(destination_1).Shapes.PasteSpecial(ppPasteEnhancedMetafile)
     .Top = 45  'desired top position
     .Left = 30  'desired left position
     .Width = 350
End With

wb1.Sheets("Place_Holder").Shapes(1).Delete

objWord.DisplayAlerts = False
objWord.Quit
objWord.DisplayAlerts = True

Next

here:


PP.Save

PP.Close


End Sub

Answer 1

在VBA编辑器中的工具下，选择参考＆gt; Microsoft PowerPoint对象库

Sub Debates_to_PP()
Dim destination_1 As Long
Dim objWord As Object

Set wb1 = ActiveWorkbook

'set slide destinations --- (needs to be a loop)
destination_1 = wb1.Sheets("Dash").Cells(12, 8).Value


'get path for PP
PPPath_name = wb1.Sheets("Dash").Cells(4, 10).Value
PPfile_name = wb1.Sheets("Dash").Cells(4, 11).Value

'Combine File Path names
PPfiletoopen = PPPath_name & "\" & PPfile_name

'Get path
Path_name = wb1.Sheets("Dash").Cells(12, 10).Value
file_name = wb1.Sheets("Dash").Cells(12, 11).Value

'Combine File Path names
filetoopen = Path_name & "\" & file_name

'Browse for a file to be open
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Set word_1 = objWord.Documents.Open(filetoopen)

'open power point---------------------------------------------------------------------
Dim objPPT As PowerPoint.Application

Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True

'Open PP file
objPPT.Presentations.Open Filename:=PPfiletoopen
Dim PP as PowerPoint.Presentation
Set PP = objPPT.activepresentation

'Copy and paste table-----------------------------------------------------------------
word_1.tables(1).Range.Copy
PP.slides(destination_1).Shapes.PasteSpecial(ppPasteEnhancedMetafile)





PP.Save

PP.Close


word_1.Close



End Sub

VBA，如何将word表作为图片（增强型图元文件）粘贴到电源点？

1 个答案: