数组

时间:2017-09-27 20:15:09

标签: vba excel-vba powerpoint-vba excel

我在几个变量上得到Run-time error 91,我真的不知道我做错了什么......

变量包括:IQRngReftempRngunionVariable

我认为除了unionVariable(至少它不应该)之外,它们都是除了unionVariable之外的所有数组。

我可以在这里得到一些帮助吗?

    Option Explicit

    Private Sub averageScoreRelay()
        ' 1. Run from PPT and open an Excel file
        ' 2. Start at slide 1 and find a box that contains the words "iq_", if it has those words then it will have numbers after it like so "iq_43" or "iq_43, iq_56,iq_72".
        ' 3. find those words and numbers in the opened Excel file after splitting and re-formating string.
        ' 3. Copy column into a new sheets and repeat for all "iq_'s" until sheets 2 has a table.
        ' 4. Copy table from xl Paste Table into ppt
        ' 5. Do this for every slide

        'Timer start
        Dim StartTime As Double
        Dim SecondsElapsed As Double
        StartTime = Timer


        'Create variables
        Dim xlApp As Excel.Application
        Dim xlWB As Excel.Workbook
        Dim ShRef As Excel.Worksheet
        Dim pptPres As Object
        Dim colNumb As Long
        Dim rowNumb As Long

        ' 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\Macros\averageScores\pptxlpratice\dummy2.xlsx", True, False, , , , True, Notify:=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
        xlApp.DisplayAlerts = False

        'Find # of iq's in workbook
        Set ShRef = xlWB.Worksheets("Sheet1")
        colNumb = ShRef.Cells(1, ShRef.Columns.Count).End(xlToLeft).Column
        rowNumb = ShRef.Cells(ShRef.Rows.Count, 1).End(xlUp).Row

        Dim IQRef() As String
        Dim iCol As Long
        Dim IQRngRef() As Range

        ReDim IQRef(colNumb)
        ReDim IQRngRef(colNumb)

        ' capture IQ refs locally
        For iCol = 2 To colNumb
            IQRngRef(iCol) = ShRef.Range(ShRef.Cells(1, iCol), ShRef.Cells(rowNumb, iCol)).Value
            IQRef(iCol) = ShRef.Cells(1, iCol).Value
        Next iCol

        'Make pptPres the ppt active
        Set pptPres = PowerPoint.ActivePresentation

        'Create variables for the slide loop
        Dim pptSlide As Slide
        Dim Shpe As Shape
        Dim pptText As String
        Dim iq_Array As Variant
        Dim arrayLoop As Long
        Dim myShape As Object
        Dim outCol As Long
        Dim i As Long
        Dim lRows As Long
        Dim lCols As Long
        Dim k As Long

        'Loop through each pptSlide and check for IQ text box, grab avgScore values and create pptTable
        For Each pptSlide In pptPres.Slides

            i = 0
            pptSlide.Select

            'searches through shapes in the slide
            For Each Shpe In pptSlide.Shapes

                If Not Shpe.HasTextFrame Then GoTo nextShpe 'boom, one less nested If statement
                If Not Shpe.TextFrame.HasText Then GoTo nextShpe ' boom, another nested If statement bites the dust

                outCol = 0

                'Set pptText as the Text in the box, then make it lowercase and trim Spaces and Enters
                pptText = Shpe.TextFrame.TextRange
                pptText = LCase(Replace(pptText, " ", vbNullString))
                pptText = Replace(Replace(Replace(pptText, vbCrLf, vbNullString), vbCr, vbNullString), vbLf, vbNullString)


                'Identify if within text there is "iq_"
                If InStr(1, pptText, "iq_") <= 0 Then GoTo nextShpe

                'set iq_Array as an array of the split iq's
                iq_Array = Split(pptText, ",")

                Dim hasIQs As Boolean
                Dim checkStr As String
                Dim pCol As Long
                Dim checkOne

                checkOne = iq_Array(0)

                hasIQs = Left(checkOne, 3) = "iq_"

                Dim tempRng() As Range

                If hasIQs Then
                    ' paste inital column into temporary worksheet
                    tempRng(0) = ShRef.Columns(1)
                End If

                ' loop for each iq_ in the array
                For arrayLoop = LBound(iq_Array) To UBound(iq_Array)
                    ' Take copy of potential ref and adjust to standard if required
                    checkStr = iq_Array(arrayLoop)
                    If hasIQs And Left(checkStr, 3) <> "iq_" Then checkStr = "iq_" & checkStr

                    ' Look for existence of corresponding column in local copy array
                    pCol = 0
                    For iCol = 2 To colNumb
                        If checkStr = IQRef(iCol) Then
                            pCol = iCol
                            Exit For
                        End If
                    Next iCol

                    If pCol > 0 Then
                        ' Paste the corresponding column into the forming table
                        outCol = outCol + 1
                        tempRng(outCol) = ShRef.Columns(pCol)
                    End If

                Next arrayLoop

                If outCol > 1 Then                   'data was added
                    ' Copy table

                    Dim unionVariable As Range

                    unionVariable = tempRng(0)


                    For k = 1 To i
                        unionVariable = Union(unionVariable, tempRng(k))
                    Next k

                    unionVariable.Copy               ' all the data added to ShWork

tryAgain:

                    ActiveWindow.ViewType = ppViewNormal
                    ActiveWindow.Panes(2).Activate

                    Set myShape = pptSlide.Shapes.PasteSpecial(DataType:=ppPasteHTML, Link:=msoFalse)

                    On Error GoTo tryAgain
                    On Error GoTo clrSht

                    'Set position:
                    myShape.Left = -200
                    myShape.Top = 150 + i
                    i = i + 150

                End If

clrSht:

                'Clear Sheet2 for next slide
                Erase tempRng()

nextShpe:

            Next Shpe

nextSlide:

        Next pptSlide

        xlWB.Close
        xlApp.Quit

        xlApp.DisplayAlerts = True

        'End Timer
        SecondsElapsed = Round(Timer - StartTime, 2)
        MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation

    End Sub

1 个答案:

答案 0 :(得分:3)

Dim something() As String

声明一个动态大小的数组,其中每个项目都是String。调整大小后,您可以执行此操作(假设i位于数组的边界内):

something(i) = "foo"

现在这个:

Dim something() As Range

声明一个动态大小的数组,其中每个项目都是Range。调整大小后,您可以执行此操作(假设i位于数组的边界内):

Set something(i) = Range("A1")

每当您分配对象引用时,请注意{@ 1}}关键字 - 它在VBA中 Set作为对象,您需要Range关键字进行该分配。

在您的代码中:

Set

确实是tempRng(0) = ShRef.Columns(1) ,但缺少Range关键字。这将抛出你正在获得的RTE91。

同样在这里:

Set

您无法在没有unionVariable = tempRng(0) 关键字的情况下分配对象引用。

虽然:

Set

那不是IQRngRef(iCol) = ShRef.Range(ShRef.Cells(1, iCol), ShRef.Cells(rowNumb, iCol)).Value 。它是Range的{​​{1}},并且.Value - 不是对象,因此添加Range关键字不会解决任何问题。如果您的意思是Variant来保留Set个对象,则需要执行此操作:

IQRngRef