繁体   English   中英

VBA PowerPoint:从 PowerPoint 中提取形状文本

[英]VBA PowerPoint: Extract Shape Text from PowerPoint

我正在尝试修改下面现有的 PowerPoint VBA 代码,以包含除了列出的其他属性之外的形状文本。 此代码的目的是从 PowerPoint 中提取每个形状/文本框及其属性并将其转储到表格中。

我添加的行就在下面,我尝试过 oSh.TextFrame oSh.TextRange 和没有运气的组合。 它返回一个有标题但完全空白的文件。 知道我做错了什么,为什么这不起作用?

& oSh.Text & vbTab _

完整代码:

Sub ExportCoords()

    Dim oSlides As Slides
    Dim oSl As Slide
    Dim oSh As Shape
    Dim strOutput As String
    Dim strFileName As String
    Dim intFileNum As Integer
    Dim lngReturn As Long

    ' Get a filename to store the collected text
    strFileName = InputBox("Enter the full path and name of file to save info to", "Output file?")

    ' did user cancel?
    If strFileName = "" Then
        Exit Sub
    End If

    ' is the path valid?  crude but effective test:  try to create the file.
    intFileNum = FreeFile()
    On Error Resume Next
    Open strFileName For Output As intFileNum
    If Err.Number <> 0 Then     ' we have a problem
        MsgBox "Couldn't create the file: " & strFileName & vbCrLf _
            & "Please try again."
        Exit Sub
    End If
    Close #intFileNum  ' temporarily

    strOutput = "Slide" & vbTab & "Name" & vbTab & "Text" & vbTab & "Type" _
    & vbtab & "Left" & vbTab & "Top" & vbTab & "width" _
    & vbTab & "height" & vbCrLf

    ' Get the info
    Set oSlides = ActivePresentation.Slides
    For Each oSl In oSlides
        For Each oSh In oSl.Shapes
            strOutput = strOutput _
                & oSl.SlideIndex & vbTab _
                & oSh.Name & vbTab _
                & oSh.Text & vbTab _
                & osh.Type & vbtab _
                & oSh.Left & vbTab _
                & oSh.Top & vbTab _
                & oSh.width & vbTab _
                & oSh.height & vbCrLf
        Next oSh
    Next oSl

    ' now write the text to file
    Open strFileName For Output As intFileNum
    Print #intFileNum, strOutput
    Close #intFileNum

    ' show what we've done
    lngReturn = Shell("NOTEPAD.EXE " & strFileName, vbNormalFocus)

End Sub

示例输出: 在此处输入图片说明

您应该使用 oSh.TextFrame.TextRange.Text 而不是 oSh.Text,然后它将获取形状内的文本。

发生这种情况是因为 TextFrame 对象除了文本值之外还有其他属性。 例如,在下面的代码中(来自https://docs.microsoft.com/pt-br/office/vba/api/powerpoint.shape.textframe ),您可以设置边距和文本值。

Set myDocument = ActivePresentation.Slides(1)
With myDocument.Shapes _
        .AddShape(msoShapeRectangle, 180, 175, 350, 140).TextFrame
    .TextRange.Text = "Here is some test text"
    .MarginTop = 10
End With

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM