☰

Extraia texto do PowerPoint

tag-icon • tag-icon vba microsoft-powerpoint extract
Extraia texto do PowerPoint

Então, encontrei este script legal aqui: http://www.pptfaq.com/FAQ00274_Export_Text_to_a_text_file-_extract_text_from_PowerPoint_-Mac_or_PC-.htm (estou usando o segundo)

A parte de importação é esta:

 For Each oShp In oSld.Shapes                'Loop thru each shape on slide
      'Check to see if shape has a text frame and text
      If oShp.HasTextFrame And oShp.TextFrame.HasText Then
        If oShp.Type = msoPlaceholder Then
            Select Case oShp.PlaceholderFormat.Type
                Case Is = ppPlaceholderTitle, ppPlaceholderCenterTitle
                    Print #iFile, "Title:" & vbTab & oShp.TextFrame.TextRange
                Case Is = ppPlaceholderBody
                    Print #iFile, "Body:" & vbTab & oShp.TextFrame.TextRange
                Case Is = ppPlaceholderSubtitle
                    Print #iFile, "SubTitle:" & vbTab & oShp.TextFrame.TextRange
                Case Else
                    Print #iFile, "Other Placeholder:" & vbTab & oShp.TextFrame.TextRange
            End Select
        Else
            Print #iFile, vbTab & oShp.TextFrame.TextRange
        End If  ' msoPlaceholder
      Else  ' it doesn't have a textframe - it might be a group that contains text so:
        If oShp.Type = msoGroup Then
            sTempString = TextFromGroupShape(oShp)
            If Len(sTempString) > 0 Then
                Print #iFile, sTempString
            End If
        End If
      End If    ' Has text frame/Has text

    Next oShp

Já modifiquei um pouco, então o arquivo de saída não contém "Título", "Outro Placeholder" e tal texto e nem insere abas ("vbTab"). No entanto, ele coloca cada linha (ou parágrafo) em uma nova linha no arquivo de saída.

A questão:Como posso dizer ao script para despejar todo o 'conteúdo' de um 'slide'/'corpo' na mesma linha/célula?

Notei que este script (e nem estehttp://www.pptfaq.com/FAQ00332_Export_Slide_Number_and_Title_Text_to_a_text_file.htm) exibe esse comportamento para títulos, apenas para "body" ou "ppPlaceholderBody".

Não tenho ideia do porquê disso ou qual é a diferença. Será que ele simplesmente não consegue distinguir entre duas linhas ou boletins, mesmo no mesmo formato/caixa? Meu objetivo é ter uma numeração consistente de linhas/células em vários .ppts, para que uma linha adicionada no slide 2 não faça com que o conteúdo do slide 5 seja deslocado para a próxima linha.

Obrigado pela ajuda!

Responder1

Minha instalação do PowerPoint está inoperante no momento, portanto não foi testada. Mas...

Você só precisa criar uma variável de string e adicioná-la e, quando terminar o slide, copiar essa string para uma célula do Excel.

Dim slideText As String
For Each oShp In oSld.Shapes                 'Loop thru each shape on slide
    If Len(slideText) > 0 Then
        '--- strip the unneeded trailing CRLF
        slideText = Left$(slideText, Len(slideText) - 2)
        '--- now copy the string to the appropriate cell in Excel
    Else
        '--- clear the string for the next slide
        slideText = vbNullString
    End If

    'Check to see if shape has a text frame and text
    If oShp.HasTextFrame Then
        If oShp.TextFrame.HasText Then
            If oShp.Type = msoPlaceholder Then
                Select Case oShp.PlaceholderFormat.Type
                    Case Is = ppPlaceholderTitle, ppPlaceholderCenterTitle
                        slideText = slideText & "Title:" & vbTab & _
                                    oShp.TextFrame.TextRange & vbCrLf
                    Case Is = ppPlaceholderBody
                        slideText = slideText & "Body:" & vbTab & _
                                    oShp.TextFrame.TextRange & vbCrLf
                    Case Is = ppPlaceholderSubtitle
                        slideText = slideText & "SubTitle:" & vbTab & _
                                    oShp.TextFrame.TextRange & vbCrLf
                    Case Else
                        slideText = slideText & "Other Placeholder:" & _
                                    vbTab & oShp.TextFrame.TextRange & vbCrLf
                End Select
            Else
                slideText = slideText & vbTab & oShp.TextFrame.TextRange
            End If                           ' msoPlaceholder
        End If
    Else
        ' it doesn't have a textframe - it might be a group that contains text so:
        If oShp.Type = msoGroup Then
            sTempString = TextFromGroupShape(oShp)
            If Len(sTempString) > 0 Then
                slideText = slideText & sTempString & vbCrLf
            End If
        End If
    End If                                   ' Has text frame/Has text
Next oShp

'--- catch the text on the last slide here
If Len(slideText) > 0 Then
    '--- strip the unneeded trailing CRLF
    slideText = Left$(slideText, Len(slideText) - 2)
    '--- now copy the string to the appropriate cell in Excel
End If

Claro, você está fazendo esse loop para cada slide.

Responder2

Não acho que isso ajude, mas isto:https://stackoverflow.com/questions/45468824/printing-from-ppt-vba-to-an-excel-spreadsheet tenta algo semelhante usando Lbound e Ubound para imprimir em células específicas.

Contanto que as células permaneçam consistentes em vários ppt/xls, eu realmente não sei para onde vão as strings ...

(Embora ele também selecione um arquivo xls específico, embora eu queira criar um novo para cada impressão, isso não deve ser um problema com o código que já tenho, que cria um arquivo especificado ou usa o nome do arquivo do ppt. )

informação relacionada