我在几个变量上得到Run-time error 91
,我真的不知道我做错了什么......
变量包括:IQRngRef
,tempRng
,unionVariable
我认为除了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
答案 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