excel - 将文本从 PowerPoint 文本框导出到 Excel 单元格 (VBA)

Question

长话短说，我需要维护一个参考表，将标准映射到解决这些标准的幻灯片。显然，这很痛苦，因为人们会在最后一刻更新 PowerPoint。

我的目标是拥有一个可以执行以下操作的宏：

1. 我将所有 PowerPoint 文件放在给定文件夹中（我们将它.../ImportMe）
2. 运行打开每个 PowerPoint 文件的脚本。
3. 在 B 列中列出幻灯片#
4. 找到我正在寻找的文本框（这些都以“CT：”开头）。复制文本并将其粘贴到相应行的 C 列中。
5. 将 PowerPoint 文件名放在所有适用行的 A 列中。

即下面...

我已经创建了可以让我获得幻灯片编号的代码（我可以获得文件名，尽管我还没有这样做）。我正在努力从特定文本框中复制和粘贴数据（或者根本没有，真的）——这是我目前想要关注的部分......

 Set xlSheet = Excel.Application.ActiveWorkbook.Sheets("Reference Table")

pptpath = "C:\Users\Username\ImportMe"
Set PP = CreateObject("PowerPoint.Application")
Set pptPres = PP.Presentations.Open(pptpath)
PP.Visible = msoCTrue

For Each pptSlide In pptPres.Slides
            'Find new last row
            LastRow = xlSheet.Range("B" & xlSheet.Rows.Count).End(xlUp).Row
            NewRow = LastRow + 1
            
            xlSheet.Range("B" & NewRow).Value = pptSlide.SlideNumber
            
            For Each pptShape In pptSlide.Shapes
                    If pptShape.TextFrame2.HasText Then
                        pptText = pptShape.TextFrame2.TextRange.Text
                            If InStr(1, pptText, "CT:") > 0 Then
                                    'pptShape.TextFrame2.TextRange.Copy
                                    xlSheet.Range("C" & NewRow).Value = pptText
                            Else
                                 'Do Nothing
                            End If
                    Else
                        'Do Nothing
                    End If
            Next pptShape
    Next pptSlide

pptPres.Close
 

这只是在 C 列中给了我一个空白。我的印象是我没有正确循环遍历 PowerPoint“形状”。我这么说是因为它会正确地将幻灯片 # 放在 B 列中。

请让我知道，如果你有任何问题！

编辑地址评论：

1. 添加了附加代码
2. 代码托管在excel中
3. 使用“.Value”我得到了同样的结果

***重要提示：我有一个错误绕过（不知道为什么 - 这在测试代码时很愚蠢）。我把它关掉了，我收到错误...

运行时错误“-2147024893 (80070003)”：反对“演示文稿”的方法“打开”失败

这没有任何意义，因为代码能够打开 PP 并拉动幻灯片#。

标签： excelvbapowerpoint