Question

我有一个PDF文件，最初是从PPT（我无权访问）创建的。我需要从PDF的每个页面中提取标题/标题到一个文档（格式无关; Excel，记事本，Word，任何事情都可以）。因此，文件很大，无法手动完成，我将不得不再次为类似的文件执行此操作。

我的结论是将PDF转换回PPT格式会有所帮助，我试图在PowerPoint VBA中编写子程序。请看下面的代码，并建议我可以改变什么来实现这一目标？备选的想法也欢迎。

抬头：转换回PPT后，每张幻灯片中的标题不再位于PowerPoint中的“标题”占位符中。它们只是普通的文本框。我是VBA的新手，我已经通过Googling编译了代码。

输出：打印出带有幻灯片编号列表的记事本文件。对于每张幻灯片，它会打印相应的幻灯片编号，与幻灯片中的文本框一样多次。例如：幻灯片1有3个文本框，因此记事本显示：

“幻灯片：1

幻灯片：1

幻灯片：2

幻灯片：2“

问题：它不是从文本框中打印文本。实际上，我只需要顶部文本框中的文本（首先放在幻灯片上或放在幻灯片的最顶部）。

代码：

Sub GatherTitles()

On Error GoTo ErrorHandler

Dim oSlide As Slide
Dim strTitles As String
Dim strFilename As String
Dim intFileNum As Integer
Dim PathSep As String
Dim Shp As Shape

If ActivePresentation.Path = "" Then
    MsgBox "Please save the presentation then try again"
    Exit Sub
End If

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

On Error Resume Next  ' in case there's no title placeholder on the slide
For Each oSlide In ActiveWindow.Presentation.Slides

    For Each Shp In oSlide.Shapes
      Select Case Shp.Type
        Case MsoShapeType.msoTextBox

    strTitles = strTitles _
        & "Slide: " _
        & CStr(oSlide.SlideIndex) & vbCrLf _
        & oSlide.Shapes(1).TextFrame.TextRange.Text _
        & vbCrLf & vbCrLf

        Case Else
          Debug.Print Sld.Name, Shp.Name, "This is not a text box"
      End Select

    Next Shp
Next oSlide
On Error GoTo ErrorHandler

intFileNum = FreeFile

' PC-Centricity Alert!
' This assumes that the file has a .PPT extension and strips it off to make the text file name.
strFilename = ActivePresentation.Path _
    & PathSep _
    & Mid$(ActivePresentation.Name, 1, Len(ActivePresentation.Name) - 4) _
    & "_Titles.TXT"

Open strFilename For Output As intFileNum
Print #intFileNum, strTitles

NormalExit:
Close intFileNum
Exit Sub

ErrorHandler:
MsgBox Err.Description
Resume NormalExit

End Sub

Answer 1

除了检查它是否是文本框之外，你真的不是用变量Shp做任何事情。我没有足够的时间继续测试解决方案，但在行

之前

& vbCrLf & vbCrLf

尝试插入行

& ": " & Shp.TextFrame.TextRange.Text _

Answer 2

如果文本框不是占位符，则唯一的方法是检查幻灯片上每个形状的位置。因此在下面设置X和Y.

<?php

if (isset($_COOKIE['C_username'])) {
  setcookie("C_username", '', time() - 3600);
  setcookie("C_password", '', time() - 3600);
  header( 'Location: ../index.php');
  exit;
}

echo '<script>alert(document.cookie);</script>";    

?>

Answer 3

（代表OP发表。）

问题已经解决了。最终代码供参考，以防其他人启动VBA PowerPoint：

Sub GatherTitles()

On Error GoTo ErrorHandler

Dim oSlide As Slide
Dim strTitles As String
Dim strFilename As String
Dim intFileNum As Integer
Dim PathSep As String
Dim Shp As Shape
Dim Count As Integer
Dim Mn As Double

If ActivePresentation.Path = "" Then
    MsgBox "Please save the presentation then try again"
    Exit Sub
End If

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

On Error Resume Next  ' in case there's no title placeholder on the slide
For Each oSlide In ActiveWindow.Presentation.Slides
Count = 0

    For Each Shp In oSlide.Shapes
      Select Case Shp.Type
        Case MsoShapeType.msoTextBox
Count = Count + 1
        Case Else
          Debug.Print Sld.Name, Shp.Name, "This is not a text box"
      End Select
    Next Shp
Count = Count - 1
Dim distmat() As Double
ReDim distmat(0 To Count)
Dim i As Integer
i = 0
    For Each Shp In oSlide.Shapes
      Select Case Shp.Type
        Case MsoShapeType.msoTextBox
distmat(i) = Shp.Top
i = i + 1
        Case Else
          Debug.Print Sld.Name, Shp.Name, "This is not a text box"
      End Select
    Next Shp
Mn = distmat(0)
i = i - 1
For j = 1 To i
If distmat(j) < Mn Then
Mn = distmat(j)
End If
Next j

'Next oSlide

'For Each oSlide In ActiveWindow.Presentation.Slides
    For Each Shp In oSlide.Shapes
      Select Case Shp.Type
        Case MsoShapeType.msoTextBox
 If Shp.Top = Mn Then
    strTitles = strTitles _
        & "Slide: " _
        & CStr(oSlide.SlideIndex) & vbCrLf _
        & oSlide.Shapes(1).TextFrame.TextRange.Text _
        & Shp.TextFrame.TextRange.Text & vbCrLf _
        & vbCrLf & vbCrLf
Else
Debug.Print Sld.Name, Shp.Name, "This is not the topmost textbox"
End If

        Case Else
          Debug.Print Sld.Name, Shp.Name, "This is not a text box"
      End Select

    Next Shp
Next oSlide
On Error GoTo ErrorHandler

intFileNum = FreeFile

' PC-Centricity Alert!
' This assumes that the file has a .PPT extension and strips it off to make the text file name.
strFilename = ActivePresentation.Path _
    & PathSep _
    & Mid$(ActivePresentation.Name, 1, Len(ActivePresentation.Name) - 4) _
    & "_Titles.TXT"

Open strFilename For Output As intFileNum
Print #intFileNum, strTitles

NormalExit:
Close intFileNum
Exit Sub

ErrorHandler:
MsgBox Err.Description
Resume NormalExit

End Sub

从powerpoint文本框（而不是占位符）中提取标题？

3 个答案: