excel - 使用VBA从ppt表中提取文本并粘贴到excel中

Question

我有一个挑战来创建一个宏，从每个表中提取数据（文本）并将文本粘贴到 excel 表中，我可以这样做，但我需要将文本定位在 excel 电子表格中，ppt 中的表是如何定位的例如：如果第一个 ppt 表坐标值（左 = 16 和顶部 = 16）那么从第一个表复制的文本应该粘贴到 excel 中的相同坐标值（左 = 16 和顶部 = 12）中

这是供参考的图像

此代码从表中提取并粘贴数据，但它将文本放置在另一个下方，如下所示

这是代码

Option Explicit

Sub GetTableNames()

Dim pptpres As Presentation
Set pptpres = ActivePresentation

Dim pptSlide As Slide
Set pptSlide = Application.ActiveWindow.View.Slide

Dim pptShapes As Shape, pptTable As Table

Dim XL As Object, WS As Object
Dim arr As Variant, nextTablePlace As Integer, cnt As Integer

Set XL = CreateObject("Excel.Application")
With XL.Workbooks.Add
    Set WS = .Worksheets(1)
End With

nextTablePlace = 1  ' to output first table content into Worksheet

For Each pptSlide In pptpres.Slides
    For Each pptShapes In pptSlide.Shapes
        If pptShapes.HasTable Then
            cnt = cnt + 1
            Set pptTable = pptShapes.Table
            WS.Cells(nextTablePlace, 1) = "Table #: " & cnt ' caption for each table
            nextTablePlace = nextTablePlace + 1
            ReDim arr(1 To pptTable.Rows.Count, 1 To pptTable.Columns.Count) ' resize array to table dimensions
            Dim rr As Integer
            Dim cc As Integer
            For rr = 1 To pptTable.Rows.Count
                For cc = 1 To pptTable.Columns.Count
                    arr(rr, cc) = pptTable.Cell(rr, cc).Shape.TextFrame.TextRange.Text   'get text from each cell into array
                Next
            Next
            
            
            WS.Cells(nextTablePlace, 1).Resize(pptTable.Rows.Count, pptTable.Columns.Count) = arr
            
            ' to next place with gap
            nextTablePlace = nextTablePlace + pptTable.Rows.Count + 2
        End If
    Next
Next
XL.Visible = True

End Sub

我可以从 ppt 中获取表格的坐标值，但我不知道使用 ppt 表格的坐标值并使用它们在 excel 中定位文本

我需要帮助

谢谢

标签： excelvba