5

У меня есть файл презентации Powerpoint (.pptx) с 100 слайдами. Я хочу взять весь текст из него и сохранить его в виде простого текстового файла.

Как я могу это сделать? Похоже, что PowerPoint не позволяет вам сохранять его как текстовый файл напрямую, и я не хочу просматривать каждый слайд, чтобы скопировать текст.

|источник

3 ответа3

2

Экспортируйте как PDF, копируйте и вставляйте (CTRL+A, CTRL+C) из вашего PDF-ридера.

Если вы хотите немного отформатировать, экспортируйте PDF через pdftotext с параметром -layout

|источник
1

Если весь текст в презентации виден в представлении Outline, вы должны быть в состоянии сделать File | Сохранить как | Выберите Outline (RTF).

В противном случае вам понадобится немного VBA. На моем сайте часто задаваемых вопросов по PowerPoint есть несколько примеров:

Экспорт текста в текстовый файл, извлечение текста из PowerPoint (Mac или ПК):

См .: http://www.pptfaq.com/FAQ00274_Export_Text_to_a_text_file-_extract_text_from_PowerPoint_-Mac_or_PC-.htm

Он сохраняет текст из каждой фигуры на страницах заметок в файл с именем NotesText.TXT в той же папке, что и сама презентация PowerPoint.

Sub SaveNotesText()

Dim oPres As Presentation
Dim oSlides As Slides
Dim oSlide As Slide
Dim oShapes As Shapes
Dim oSh As Shape
Dim NotesText As String
Dim FileNum As Integer
Dim PathSep As String

#If Mac Then
    PathSep = ":"
#Else
    PathSep = "\"
#End If

Set oPres = ActivePresentation
Set oSlides = oPres.Slides

For Each oSlide In oSlides
    NotesText = NotesText & "Slide " & oSlide.SlideIndex & vbCrLf
    Set oShapes = oSlide.NotesPage.Shapes
    For Each oSh In oShapes
        If oSh.HasTextFrame Then
            If oSh.TextFrame.HasText Then
                NotesText = NotesText & oSh.TextFrame.TextRange.Text
            End If
        End If
    Next oSh
    NotesText = NotesText & vbCrLf
Next oSlide

FileNum = FreeFile
Open oPres.Path & PathSep & "NotesText.TXT" For Output As FileNum
Print #FileNum, NotesText
Close FileNum

End Sub

Вот макрос от Криса Ландера, который будет экспортировать весь текст на каждом слайде в презентации. Немного изменил его, чтобы он работал на Mac и различал заголовок, подзаголовок, текст и другой текст.

Sub ExportText()

  Dim oPres As Presentation
  Dim oSlides As Slides
  Dim oSld As Slide         'Slide Object
  Dim oShp As Shape         'Shape Object
  Dim iFile As Integer      'File handle for output
  iFile = FreeFile          'Get a free file number
  Dim PathSep As String
  Dim FileNum As Integer

  #If Mac Then
    PathSep = ":"
  #Else
    PathSep = "\"
  #End If

  Set oPres = ActivePresentation
  Set oSlides = oPres.Slides

  FileNum = FreeFile

  'Open output file
  ' NOTE:  errors here if file hasn't been saved
  Open oPres.Path & PathSep & "AllText.TXT" For Output As FileNum

  For Each oSld In oSlides    'Loop thru each slide
    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
      End If    ' Has text frame/Has text

    Next oShp
  Next oSld

  'Close output file
  Close #iFile

End Sub

И здесь мы становимся немного хитрее и следуем за текстом, который есть в группах. И в группах внутри групп. Посмотрите на это слишком внимательно, и ваша голова может начать болеть.

Sub ExportText()

  Dim oPres As Presentation
  Dim oSlides As Slides
  Dim oSld As Slide         'Slide Object
  Dim oShp As Shape         'Shape Object
  Dim iFile As Integer      'File handle for output
  iFile = FreeFile          'Get a free file number
  Dim PathSep As String
  Dim FileNum As Integer
  Dim sTempString As String

  #If Mac Then
    PathSep = ":"
  #Else
    PathSep = "\"
  #End If

  Set oPres = ActivePresentation
  Set oSlides = oPres.Slides

  FileNum = FreeFile

  'Open output file
  ' NOTE:  errors here if file hasn't been saved
  Open oPres.Path & PathSep & "AllText.TXT" For Output As FileNum

  For Each oSld In oSlides    'Loop thru each slide
    ' Include the slide number (the number that will appear in slide's
    ' page number placeholder; you could also use SlideIndex
    ' for the ordinal number of the slide in the file
    Print #iFile, "Slide:" & vbTab & cstr(oSld.SlideNumber)

    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
  Next oSld

  'Close output file
  Close #iFile

End Sub

Function TextFromGroupShape(oSh As Shape) As String
' Returns the text from the shapes in a group
' and recursively, text within shapes within groups within groups etc.

    Dim oGpSh As Shape
    Dim sTempText As String

    If oSh.Type = msoGroup Then
        For Each oGpSh In oSh.GroupItems
            With oGpSh
                If .Type = msoGroup Then
                    sTempText = sTempText & TextFromGroupShape(oGpSh)
                Else
                    If .HasTextFrame Then
                        If .TextFrame.HasText Then
                            sTempText = sTempText & "(Gp:) " & .TextFrame.TextRange.Text & vbCrLf
                        End If
                    End If
                End If
            End With
        Next
    End If

    TextFromGroupShape = sTempText

NormalExit:
    Exit Function

Errorhandler:
    Resume Next

End Function
|источник
1

Это решение зависит от совместимости вашей слайд-платформы с Google Slides, но вы можете использовать опцию "Скачать как обычный текст" в Google Slides:

Конечно, вы потеряете все сложное форматирование или макет, но вы получите текст документа.

|источник

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .