从存储在数组中的.Values创建表

时间:2017-10-20 14:28:10

标签: vba excel-vba powerpoint-vba excel

我刚开始使用2D数组,并希望变得更好。

目前一切进展顺利,我的数组正如我想要的那样填充,但我无法弄清楚如何将其放入表中。

现在我将每个单元格的值存储在相应的数组槽中。因此Range(B1:B4)存储在IQRef(1, 2), IQRef(2, 2), IQRef(3, 2), IQRef(4, 2)中。

对于我正在做的事情,直接存储Range不是一种选择。粘贴非连续范围的PowerPoint问题......

所以我想要做的就是用这些值创建一个表格,我将把它粘贴到PowerPoint中。

这是我尝试“连接”存储在数组中的所有单个值的失败:Set unionVariable = xlApp.Union(IQRef(1, 2), IQRef(2, 2), IQRef(3, 2), IQRef(4, 2), IQRef(1, 7), IQRef(2, 7), IQRef(3, 7), IQRef(4, 7)) 显然,它失败了,因为IQRef不是Range,而Union只接受范围。

所以我的问题是,如何将我在数组中的值放到表中?

Public Sub tableArray()

    '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
    Dim i As Long
    Dim myShape As Object

    Excel.Application.DisplayAlerts = False

    ' Create new excel instance and open relevant workbook
    Set xlApp = New Excel.Application
    'xlApp.Visible = True 'Make Excel visible
    Set xlWB = xlApp.Workbooks.Open("filePath", True, False, , , , True, Notify:=False) 'Open relevant workbook
    If xlWB Is Nothing Then                      ' may not need this if statement. check later.
        MsgBox ("Error retrieving file, Check file path")
        Exit Sub
    End If

    '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 iRow As Long

    ReDim IQRef(1 To rowNumb, 2 To colNumb)
    ' capture IQ refs locally
    For iRow = 1 To rowNumb
        For iCol = 2 To colNumb
            IQRef(iRow, iCol) = ShRef.Cells(iRow, iCol).Value
        Next iCol
    Next iRow
    'Make pptPres the ppt active
    Set pptPres = PowerPoint.ActivePresentation

    'Create variables for the slide loop
    Dim pptSlide As Slide
    Dim unionVariable

    Set unionVariable = xlApp.Union(IQRef(1, 2), IQRef(2, 2), IQRef(3, 2), IQRef(4, 2), IQRef(1, 7), IQRef(2, 7), IQRef(3, 7), IQRef(4, 7))

    For Each pptSlide In pptPres.Slides

        ' Copy table
        unionVariable.Copy                       ' copy unioneVariable that should be a table

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

        Set myShape = pptSlide.Shapes.PasteSpecial(DataType:=ppPasteHTML, Link:=msoFalse) 'Should paste unionVariable's table

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

    Next pptSlide

    xlWB.Close
    xlApp.Quit

    Excel.Application.DisplayAlerts = True

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

End Sub

0 个答案:

没有答案