选择 power point 幻灯片中的所有表格答案

【问题标题】：Select all Tables in power point slide选择 power point 幻灯片中的所有表格
【发布时间】：2021-04-25 00:48:53
【问题描述】：

我正在尝试创建一个宏，它使用我尝试过的 vba 选择 ppt 中幻灯片中存在的所有表，但宏正在选择最后一个表或最后创建的表

这里是代码

Sub CheckCoOrdinates()

    Dim pptPres As Presentation
    Set pptPres = Application.ActivePresentation
    
    Dim pptSlide As Slide
    Dim pptShapes As Shape

    For Each pptSlide In pptPres.Slides
        For Each pptShapes In pptSlide.Shapes
            If pptShapes.Type = msoTable Then
                Dim i As Integer
                For i = 1 To pptSlide.Shapes.Count
                    pptShapes.Select
                    pptShapes.Copy
                Next
            End If
        Next
    Next

如何为此创建宏

【问题讨论】：

据我所知，vba 不能一次选择多个表，但是我们可以在同一个循环中添加粘贴到目标的代码。请告诉我们您想对复制的数据做什么。
@ Emmanuel Donald 我想从 ppt 复制表格或表格中的数据并将其粘贴到活动的 Excel 电子表格中

标签： vba powerpoint

【解决方案1】：

不要使用 pptShapes.Select，而是使用 pptShapes.Select (False)

Select 的默认行为模仿单击新形状...单击的形状被选中，替换之前的任何选择。添加 False 参数使其行为更像 Ctrl+单击...新选择的形状被添加到当前选择中。

这适用于每张幻灯片，但您无法在多张幻灯片上选择形状，因此您必须相应地重新编写宏。

我怀疑您最好先浏览每张幻灯片，然后浏览幻灯片上的每个形状，然后一次复制/粘贴一个表格。

【讨论】：

【解决方案2】：

    Dim pptPres As Presentation
    Set pptPres = Application.ActivePresentation
    
    
    Dim xlApp As Object
    Dim xlWorkBook As Object
    Dim j As Integer
    Dim r1 As String
    
    j = 1
    
    Set xlApp = CreateObject("Excel.Application")

    xlApp.Visible = True
    Set xlWorkBook = xlApp.Workbooks.Open("D:\Book2.xlsx", True, False)



    
    
    Dim pptSlide As Slide
    Dim pptShapes As Shape
    
    For Each pptSlide In pptPres.Slides
        For Each pptShapes In pptSlide.Shapes
        
            If pptShapes.Type = msoTable Then
                Dim i As Integer
                For i = 1 To pptSlide.Shapes.Count
                    pptSlide.Select
                    pptShapes.Select 'msoFalse
                    
                    pptShapes.Copy
                    
                    
                    xlWorkBook.sheets(1).Activate
                    
                    r1 = "A" + CStr(j)
                    xlWorkBook.sheets(1).Range(r1).PasteSpecial Paste:=xlPasteValues
                    j = j + 20
                    
                Next
            End If
        Next
    Next

'xlWorkBook.Close SaveChanges:=True

Set xlApp = Nothing
Set xlWorkBook = Nothing

【讨论】：