Vba 在PPT中查找形状并检索文本，然后在Excel中搜索该文本，复制列，然后将其作为表格粘贴回PPT中

这是我第一次真正尝试在VBA中创建一些东西，所以请温柔一点。 这就是我需要我的程序做的：

从PPT运行并打开Excel文件

从幻灯片1开始，找到一个包含“iq_”字样的方框（如果有） 如果有这些词，那么后面会有数字，比如“iq_43” 或“智商43、智商56、智商72”

在打开的Excel文件中查找这些单词和数字。需要 认识到“，”表示还有其他条目

复制包含ppt“iq_43”中单词的列

使用这些值将表格粘贴到ppt中

对每张幻灯片都这样做

我的底部功能有问题。这就是程序在打开的excel文件中工作的地方。这里的想法是遍历每列的标题，搜索我存储在“iq_数组”中的值。找到值后，将其下方的行复制到另一个名为“tble”的数组中（最终将作为表格粘贴到powerpoint幻灯片上）

代码当前停止在

rng = Worksheets("Sheet1").Cells(1, i).Value

我不确定我做错了什么。一旦修复，是否可以将其复制到阵列中

我认为我遇到的另一个问题是如何返回函数值。我现在有

xlFindText(iq_Array, xlWB) = tble()

在我的函数的底部，以便在我的主代码中调用它。这是正确的方法吗

Public Sub averageScoreRelay()



'Create variables
        Dim xlApp As Excel.Application
        Dim xlWB As Excel.Workbook
        Dim pptSlide As Slide
        Dim fileName As String
        Dim Shpe As Shape
        Dim pptText As String
        Dim strArray As String
        Dim pptPres As Object
        Dim PowerPointApp As Object
        Dim iq_Array

' Create new excel instance and open relevant workbook
        Set xlApp = New Excel.Application
        xlApp.Visible = True 'Make Excel visible
        Set xlWB = xlApp.Workbooks.Open("C:\Users\pinlop\Desktop\Gate\Macro\averageScores\pptxlpratice\dummyavgscore.xlsx", True, False)  'Open relevant workbook
                If xlWB Is Nothing Then                                                         ' may not need this if statement. check later.
                        MsgBox ("Error retrieving Average Score Report, Check file path")
                        Exit Sub
                End If

'Is PowerPoint already opened?
'Set PowerPointApp = GetObject(class:="PowerPoint.Application")

'Make PPT visible
Set pptPres = PowerPoint.ActivePresentation

Set pptSlide = Application.ActiveWindow.View.Slide      'Set pptSlide = pptPres.Slides _
                                                            (PowerPointApp.ActiveWindow.Selection.SlideRange.SlideIndex)  (different way of saying the same thing?)

'Loop through each pptSlide and check for IQ text box, grab avgScore values and create pptTable
        For Each pptSlide In pptPres.Slides
                'searches through shapes in the slide
                For Each Shpe In pptSlide.Shapes
                                'Identify if there is text frame
                                If Shpe.HasTextFrame Then
                                        'Identify if there's text in text frame
                                        If Shpe.TextFrame.HasText Then
                                            pptText = Shpe.TextFrame.TextRange
                                                If InStr(1, pptText, "iq_") > 0 Then 'Identify if within text there is "iq_" All IQ's have to be formatted like this "iq_42, iq_43" for now
                                                        iq_Array = Split(pptText, ", ")               'Use function below to Set iq_Array to an array of all iq_'s in the text box
                                                        xlFindText(iq_Array, xlWB).Copy
                                                        pptSlide.Shapes.PasteSpecial DataType:=ppPasteHTML, Link:=msoFalse                      ' Paste the Array
                                                End If
                                        End If
                                End If
                Next Shpe
        Next pptSlide

End Sub


Function xlFindText(iq_Array, xlWB) 'This function works in excel and saves the column values into xlFindText(iq_Array, xlWB) to be pasted as a table into ppt
        'SetsxlTextID = to the array of iq_'s
        Dim i As Integer
        Dim k As Integer
        Dim activeWB As Excel.Workbook
        Dim size As String
        Dim rng As Range
        Dim tble As Range

        'for loop to go through values stored in array

        size = UBound(iq_Array) - LBound(iq_Array)

        For i = 0 To size                                               'loops through array values
                For k = 1 To 200                                        'loops through cloumns
                        rng = Worksheets("Sheet1").Cells(1, i).Value
                        If rng = iq_Array(i) Then         'matches column value to iq_Array
                                Columns(k).Select
                                tble(i) = Selection.Copy                'saves a copy of the range into tble() array
                        End If
                Next k
        Next i

        xlFindText(iq_Array, xlWB) = tble()

End Function

---

你的代码有几个问题，我会从头到尾讲，但很可能我遗漏了一些

(一)

这是毫无意义的，因为直接在之后您会用以下内容覆盖

pptSlide

：

    For Each pptSlide In pptPres.Slides

xlFindText

(二)

如果您使用的Office程序与运行代码的程序不同（此处为PPT中的Excel），则必须始终完全限定对象。在未指定父对象（Excel应用程序）的情况下，不要使用诸如

ActiveSheet

之类的快捷方式

所以这应该是：

xlWB.Worksheets("Sheet1").Cells(1, i).Value

这同样适用于

列（k）

(三)

rng

是一个范围对象。这与单元格值不匹配

或者

Set rng = xlWB.Worksheets("Sheet1").Cells(1, i)

或

(四)

这不是

范围。复制
的工作方式，请查看Excel联机帮助

您必须更改
xlFindText
的逻辑-要么从此函数返回列号并在主函数中执行复制+粘贴，要么在
xlFindText
中同时执行这两项操作（然后将
pptSlide
作为参数传递）。
您的代码有几个问题，我将从头到尾介绍，但很可能我错过了一些

(一)

这是毫无意义的，因为直接在之后您会用以下内容覆盖
pptSlide
：

    For Each pptSlide In pptPres.Slides

xlFindText

(二)

如果您使用的Office程序与运行代码的程序不同（此处为PPT中的Excel），则必须始终完全限定对象。在未指定父对象（Excel应用程序）的情况下，不要使用诸如
ActiveSheet
之类的快捷方式

所以这应该是：

xlWB.Worksheets("Sheet1").Cells(1, i).Value

这同样适用于
列（k）

(三)

rng
是一个范围对象。这与单元格值不匹配

或者

Set rng = xlWB.Worksheets("Sheet1").Cells(1, i)

或

(四)

这不是
范围。复制
的工作方式，请查看Excel联机帮助

您必须更改
xlFindText
的逻辑-从该函数返回列号并在主函数中执行复制+粘贴操作，或者在
xlFindText
中同时执行这两项操作（然后将
pptSlide
作为参数传递）。
如果此代码在PPT中运行，则不需要
设置PowerPointApp=GetObject（类：=“PowerPoint.Application”）
--请确保使用
Option Explicit
--常规帮助：@Andre既然我首先从powerpoint中运行了GetObject for excel，那么我是否需要它？还有，为什么我需要Option Explicit语句？它不是自动设置为true吗？感谢您提供的资源！强制执行变量声明并报告未声明或拼写错误的变量编译时的bles/常量。若要在新模块中自动设置此选项，请在VBA编辑器中设置此选项。--如果您已经设置了此选项，则一切正常，我只是想确保。对于Excel，您有
set xlApp=new Excel.Application
。只有当您要使用现有Excel实例时，才使用GetObject（）.--通过单步浏览代码和观察变量，您应该能够更清楚地了解错误所在。如果您这样做，请更新您的问题。@Andre在阅读了一般帮助并学习了如何调试之后，我已经更新了代码和问题。希望能更容易地理解我正在尝试做的事情。如果代码在PPT中运行，您不需要设置PowerPointApp=GetObject（类：=“PowerPoint.Application”）
--请确保使用
Option Explicit
--常规帮助：@Andre既然我首先从powerpoint中运行了GetObject for excel，那么我是否需要它？还有，为什么我需要Option Explicit语句？它不是自动设置为true吗？感谢您提供的资源！强制执行变量声明并报告未声明或拼写错误的变量编译时的bles/常量。若要在新模块中自动设置此选项，请在VBA编辑器中设置此选项。--如果您已经设置了此选项，则一切正常，我只是想确保。对于Excel，您有
set xlApp=new Excel.Application
。只有当您要使用现有Excel实例时，才使用GetObject（）.--通过单步浏览代码和观察变量，您应该能够更清楚地了解错误所在。如果您这样做，请更新您的问题。@Andre在阅读了一般帮助并学习了如何调试之后，我已经更新了代码和问题。希望能更容易理解我正在尝试做的事情。谢谢非常感谢你@Andre！我终于让它工作了。它没有我所希望的那么优化
tble(i) = Selection.Copy