Excel 数据导入 PowerPoint 幻灯片

Question 1

尝试类似这样的方法。我做了一些修改，以便它用工作表中的值替换幻灯片上文本 @COL1@ 的任何实例。请注意，未经测试的航空代码。

Sub CreateSlides()
'Open the Excel workbook. Change the filename here.
Dim OWB As New Excel.Workbook
Set OWB = Excel.Application.Workbooks.Open("C:\list.xlsx")
'Grab the first Worksheet in the Workbook
Dim WS As Excel.Worksheet
Dim sCurrentText As String
Dim oSl As Slide
Dim oSh As Shape
Set WS = OWB.Worksheets(1)
Dim i As Long
'Loop through each used row in Column A
For i = 1 To WS.Range("A65536").End(xlUp).Row
    'Copy the first slide and paste at the end of the presentation
    ActivePresentation.Slides(1).Copy
    Set oSl = ActivePresentation.Slides.Paste(ActivePresentation.Slides.Count + 1)
    sCurrentText = WS.Cells(i, 1).Value

    ' find each shape with "@COL1@" in text, replace it with value from worksheet
    For Each oSh In oSl.Shapes
      ' Make sure the shape can hold text and if is, that it IS holding text
      If oSh.HasTextFrame Then
        If oSh.TextFrame.HasText Then
          ' it's got text, do the replace
          With oSh.TextFrame.TextRange
            .Replace "@COL1@", sCurrentText
          End With
        End If
      End If
    Next
Next
End Sub

Answer

尝试类似这样的方法。我做了一些修改，以便它用工作表中的值替换幻灯片上文本 @COL1@ 的任何实例。请注意，未经测试的航空代码。

Sub CreateSlides()
'Open the Excel workbook. Change the filename here.
Dim OWB As New Excel.Workbook
Set OWB = Excel.Application.Workbooks.Open("C:\list.xlsx")
'Grab the first Worksheet in the Workbook
Dim WS As Excel.Worksheet
Dim sCurrentText As String
Dim oSl As Slide
Dim oSh As Shape
Set WS = OWB.Worksheets(1)
Dim i As Long
'Loop through each used row in Column A
For i = 1 To WS.Range("A65536").End(xlUp).Row
    'Copy the first slide and paste at the end of the presentation
    ActivePresentation.Slides(1).Copy
    Set oSl = ActivePresentation.Slides.Paste(ActivePresentation.Slides.Count + 1)
    sCurrentText = WS.Cells(i, 1).Value

    ' find each shape with "@COL1@" in text, replace it with value from worksheet
    For Each oSh In oSl.Shapes
      ' Make sure the shape can hold text and if is, that it IS holding text
      If oSh.HasTextFrame Then
        If oSh.TextFrame.HasText Then
          ' it's got text, do the replace
          With oSh.TextFrame.TextRange
            .Replace "@COL1@", sCurrentText
          End With
        End If
      End If
    Next
Next
End Sub

Question 2

PowerPoint 插件Excel 导入可以将 Excel 数据导入 PowerPoint

它能做什么

将 Excel 数据导入到打开的演示文稿中
方法：每张 PowerPoint 幻灯片一个 Excel 行，当前幻灯片上每个文本字段一个单元格
如果有多个 Excel 工作表，可以选择从中获取数据
如果 Excel 文件的行数多于 Powerpoint 中的幻灯片数，则可以自动添加幻灯片
如果没有足够的文本字段（形状）来包含一行中的所有数据，则会发出警告
适用于每个 Microsoft Office 版本

如何使用

下载加入
将其保存在您的 Micorsoft Office Add-In 文件夹中
提示：按Win+R并输入%应用程序数据%\漫游\微软\插件
打开 PowerPoint 并启用加载项_{Excel 2003：菜单栏 → 工具 → 加载项
Excel 2007：开始按钮 → Excel 选项 → 加载项 → 下拉菜单：Excel 加载项 → 转到
Excel 2010：文件选项卡 → 选项 → 加载项 → 下拉菜单：Excel 加载项 → 转到}
将会弹出一个新的菜单栏条目
新的导入 Excel 数据按钮将弹出一个文件对话框来选择您的 Excel 文件。
如果您有足够的文本字段，则插件将填充它们

观看此短片imgur 相册说明插件

笔记： 如果要自定义代码，你必须添加注册表项查看 Add-In 代码。
源代码可以在 pastebin 上查看

Answer