从PPT中提取文本，然后使用VBA将其粘贴到Excel中 [英] Extracting text from PPT and pasting it in Excel using VBA

问题描述

我需要从PowerPoint演示文稿的文本框中提取数据，并将其放在Excel工作表的各个单元格中.

I need to extract data from text boxes in a PowerPoint presentation and put them in respective cells in an Excel worksheet.

我已经搜索过，但找不到合适的解决方法.

I have searched but can't find a suitable work-around.

此代码用于打印幻灯片中的文本.我不明白如何在Excel单元格中进行排列.

This code is to print the text from slides. I can't understand how to arrange it in Excel cells.

Dim oPApp As Object
Dim oSlide As Object
Dim oShape As Object
    
Set oPApp = GetObject(, "PowerPoint.Application")
    
For Each oSlide In oPApp.ActivePresentation.Slides
    For Each oShape In oSlide.Shapes
        
        If oShape.Type = 1 Or oShape.Type = 14 Then
            Debug.Print oShape.TextFrame.TextRange.Text
        End If
            
    Next oShape
Next oSlide
    
Set oPApp = Nothing

幻灯片示例(输入):

工作表示例(输出):

推荐答案

假设您希望通过Excel模块完成此操作(也可以通过PowerPoint Module完成此操作)，我只需添加一些代码&对您代码的建议.但是，要在PowerPoint幻灯片中循环浏览形状时要提到它，通常按创建形状的顺序进行.因此，为了保持字段的正确顺序，您必须制定出某种方法来根据它们的位置对它们进行排序(即，根据演示文稿的top，left属性或任何其他条件).试试

Supposing you want it to be done from Excel module (it could be done from PowerPoint Module also), I just adding some codes & suggestions to your code. However it is to be mentioned while looping through Shapes in a PowerPoint Slide It generally comes in order of creation of the shape. So for maintaining proper sequence of the fields, you have to work out some way sort them according to their position (i.e. top, left property or any other criteria according to the presentation). Try

    Dim oPApp As Object
    Dim oSlide As Object
    Dim oShape As Object

    Dim Rw, StCol, Col, Sht As Long
    Rw = 2     'Starting Row of Target excel data
    StCol = 1   'Starting Column of Target excel data
    Sht = 3   'Target Worksheet no.

    Set oPApp = GetObject(, "PowerPoint.Application")
    'It will only work for already opened active presentation
    'It can also be suugested that first create a powerpoint object and then open desired preesntation fron the path

    For Each oSlide In oPApp.ActivePresentation.Slides
    Col = StCol
        For Each oShape In oSlide.Shapes
            If oShape.Type = 1 Or oShape.Type = 14 Then
            '    Debug.Print oShape.TextFrame.TextRange.Text
            'Next line was added for putting the data into excel sheet
            ThisWorkbook.Sheets(Sht).Cells(Rw, Col).Value = 
 oShape.TextFrame.TextRange.Text
            End If
        Col = Col + 1
        Next oShape
    Rw = Rw + 1
    Next oSlide

    Set oPApp = Nothing

不过请注意，msoTextBox类型为17，类型14为msoPlaceholder.

however one word of caution msoTextBox type is 17 and type 14 is msoPlaceholder.

这篇关于从PPT中提取文本，然后使用VBA将其粘贴到Excel中的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！