在Range范围内使用Cells不起作用?

时间:2017-09-13 17:59:38

标签: vba excel-vba powerpoint-vba excel

出于某种原因,这不起作用:

.Range(Cells(1, 1), Cells(lRows, lCols)).Copy

有什么想法吗?它在第78行

Option Explicit
Public 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. Needs to recognize that ", " means there is another entry.
    ' 3. Copy column containing words from ppt ie. "iq_43"
    ' 4. Paste a Table into ppt with those values
    ' 5. Do this for every slide

    'Create variables
    Dim xlApp As Excel.Application
    Dim xlWB As Excel.Workbook
    Dim pptSlide As Slide
    Dim Shpe As Shape
    Dim pptText As String
    Dim pptPres As Object
    Dim iq_Array As Variant
    Dim arrayLoop As Integer
    Dim i As Integer
    Dim myShape As Object
    Dim colNumb As Integer
    Dim size As Integer
    Dim k As Integer
    Dim vsblSld As Object
    Dim lRows As Long
    Dim lCols As Long

    colNumb = 5 'Set #of columns in the workbook

    ' 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

    xlWB.Worksheets.Add After:=xlWB.ActiveSheet

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

    '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
            k = 1
            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, ", ")               'set iq_Array as an array of the split iq's
                        size = UBound(iq_Array) - LBound(iq_Array)
                        For arrayLoop = 0 To size   'loop for each iq_array
                            For i = 1 To colNumb    'loops for checking each column
                                If i = 1 And arrayLoop = 0 Then  'Copies the first column for every slide
                                    xlWB.Worksheets("Sheet1").Columns(1).Copy   'copy column
                                    xlWB.Worksheets("Sheet2").Paste Destination:=xlWB.Worksheets("Sheet2").Columns(1)
                                ElseIf xlWB.Worksheets("Sheet1").Cells(1, i) = iq_Array(arrayLoop) And i <> 1 Then 'if iq in ppt = iq in xl and if not the first cell then execute
                                    k = k + 1
                                    xlWB.Worksheets("Sheet1").Columns(i).Copy
                                    xlWB.Worksheets("Sheet2").Paste Destination:=xlWB.Worksheets("Sheet2").Columns(k)
                                End If
                            Next i
                        Next arrayLoop
                    End If
                End If
            End If
        Next Shpe

    'calculate last row and last column
    With xlWB.Worksheets("Sheet2")
        lRows = .Cells(.Rows.Count, 1).End(xlUp).Row
        lCols = .Cells(1, .Columns.Count).End(xlToLeft).Column
        .Range(Cells(1, 1), Cells(lRows, lCols)).Copy
    End With
            pptSlide.Shapes.PasteSpecial DataType:=ppPasteHTML, Link:=msoFalse
            Set myShape = pptSlide.Shapes(pptSlide.Shapes.Count)
            'Set position:
            myShape.Left = 66
            myShape.Top = 152
            xlWB.Worksheets("Sheet2").Range("A1:P10").Clear
    Next pptSlide

    xlWB.Worksheets("Sheet2").Delete

End Sub

1 个答案:

答案 0 :(得分:2)

应该是这样的:

if (string[j] == 'a') {
  printf("%d %c\n", j, string[j]);
}

这是VBA每个人遇到的错误之一,如果他更深入一点。原因是.Range(.Cells(1, 1), .Cells(lRows, lCols)).Copy Cells都应该引用到工作表中,否则它们会引用Range

一般情况下,请考虑使用Long instead of Integer in your code