2017-09-13 1 views
1

가 작동하지 않습니다 :범위 안에있는 셀을 사용하고 있지 않습니다? 이 몇 가지 이유를 들어

.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 

답변

2

그것은해야한다에있다 :

그는 조금 더 깊은가는 경우, 모든 사람이 VBA와 경험 오류 중 하나
.Range(.Cells(1, 1), .Cells(lRows, lCols)).Copy 

. 그 이유는 CellsRange 둘 다 워크 시트를 참조해야하며, 그렇지 않으면 ActiveSheet을 참조해야합니다.


일반적으로 Long instead of Integer in your code을 사용하는 것이 좋습니다.

+0

와우 ... 나는 그 하하를 시도했다고 생각했습니다. 너무 간단! 고마워요! – Pinlop

+0

@Pinlop :) 환영합니다 – Vityata

+1

@Pinlop 질문에 올바르게 대답하면 [답변 수락] (https://meta.stackexchange.com/questions/5234/how-does-accepting-an-answer-work)을 할 수 있습니다. – danieltakeshi

관련 문제