Извлечение текста из PPT и вставка его в Excel с использованием VBA - PullRequest
Новая
       27

Извлечение текста из PPT и вставка его в Excel с использованием VBA

0 голосов
/ 29 сентября 2018

Мне нужно извлечь данные из текстовых полей в презентации PowerPoint и поместить их в соответствующие ячейки на листе Excel.Я предоставил два примера ссылок на изображения, чтобы служить примерами того, как должен выглядеть конечный результат.Я просмотрел все сайты в Интернете, но не могу найти подходящего обходного пути: (

Я новичок в VBA, и я полностью теряюсь в этом упражнении. Код, подобный этому,только помогает мне напечатать текст из слайдов, но я не могу понять, как расположить его в ячейках Excel. Может, кто-нибудь из вас поможет мне решить эту проблему? 

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

Примерслайд (вход):

Example of PPT slide (Input)

Пример листа (выход):

Example of excel sheet (Output)

1 Ответ

0 голосов
/ 30 сентября 2018

Предположим, вы хотите, чтобы это было сделано из модуля Excel (это можно сделать и из модуля PowerPoint), я просто добавил несколько кодов и предложений в ваш код.Однако это следует упомянуть при циклическом просмотре фигур в слайде PowerPoint. Обычно это происходит в порядке создания фигуры.Таким образом, для поддержания правильной последовательности полей вы должны каким-либо образом отсортировать их в соответствии с их положением (т. Е. Свойство top, left или любые другие критерии в соответствии с представлением).Попробуйте 

    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.

...