Question

我做了一个演示文稿（在Windows 10中使用Powerpoint 2016），其中有图像附加文本。我知道VBA（不是彻底）的Word或Excel，但我是PP的新手。但是Powerpoint语法让我很困惑（这也适合我的年龄）。我想提取所有幻灯片的所有标题和文本，关于这一点，我创建了以下程序，它工作正常，但不让我知道分组对象上的文本。我哪里错了？

Sub RiepilogaConWord()
Dim applWord As Word.Application
Dim docWord As Word.Document
Dim paraWord As Word.Paragraph
Dim oSh As Shape
Dim oSL As Slide

Set applWord = New Word.Application
applWord.Visible = True
applWord.WindowState = wdWindowStateMaximize
Set docWord = applWord.Documents.Add
docWord.ShowSpellingErrors = False
applWord.Selection.TypeText Text:="RIEPILOGO AL " & Format(Date, "dd/mm/YYYY") & " alle ore " & Format(Time, "hh:mm")
docWord.Paragraphs.Add
Set paraWord = docWord.Paragraphs(docWord.Paragraphs.Count)
paraWord.Range.InsertAfter "Totale diapositive " & Presentations(1).Slides.Count
docWord.Paragraphs.Add

For Each oSL In ActivePresentation.Slides
paraWord.Range.InsertAfter oSL.SlideIndex
docWord.Paragraphs.Add
Dim g As Integer
For Each oSh In oSL.Shapes
Select Case oSh.Type
Case Is = msoGroup
On Error Resume Next
oSh.Ungroup.Group , msoTextBox
For g = 1 To oSh.GroupItems.Count
If oSh.TextFrame.HasText Then
paraWord.Range.InsertAfter oSh.Name & ":= " & oSh.TextFrame.TextRange

End If
Next g
On Error GoTo errorhandler
Case Else
With oSh
If .HasTextFrame Then
If .TextFrame.HasText Then
paraWord.Range.InsertAfter oSh.Name & ":= " & .TextFrame.TextRange

End If
End If
End With

        End Select
    Next
  Next   

docWord.SaveAs FileName:="C:\EPITETI CINQUE\Presentazione\RiepilogoPresentazione"

applWord.Quit

Set docWord = Nothing
Set applWord = Nothing
Set paraWord = Nothing
Exit Sub
errorhandler:
End Sub

感谢您的帮助。弗朗西斯

Answer 1

这里有一些问题

On Error Resume Next正在隐瞒您的问题。删除它
oSh.Ungroup.Group , msoTextBox毫无意义，我不知道你在那里做什么
找到分组对象时，迭代其成员

我已经重构了您的代码以进行演示。

我已删除Word内容以使Q更清晰，只需将文本转储到立即窗口（Ctrl-G以在VBA编辑器中显示）。你可以把它添加回来......
添加了对已更改代码的评论，标记为<---
添加缩进以使代码可读

Sub RiepilogaConWord()
    Dim oSh As Shape
    Dim oSL As Slide
    Dim g As Integer '<--- move here, no point in putting it in the loop, that does nothing

    '<--- Add here to use a general error.
    ' Comment it out while debugging to expose any errors
    ' On Error GoTo errorhandler handler

    For Each oSL In ActivePresentation.Slides
        For Each oSh In oSL.Shapes
            Select Case oSh.Type
                Case Is = msoGroup
                    'On Error Resume Next  '<--- Delete this
                    'oSh.Ungroup.Group , msoTextBox '<--- Delete this
                    For g = 1 To oSh.GroupItems.Count
                        With oSh.GroupItems.Item(g) '<--- simplify
                            '<--- use g to iterate the grouped items
                            If .HasTextFrame Then '<--- more robust
                                If .TextFrame.HasText Then
                                    Debug.Print .Name & ":= " & .TextFrame.TextRange
                                End If
                            End If
                        End With
                    Next g
                    'On Error GoTo errorhandler '<--- Delete this
                Case Else
                    With oSh
                        If .HasTextFrame Then
                            If .TextFrame.HasText Then
                                Debug.Print oSh.Name & ":= " & .TextFrame.TextRange
                            End If
                        End If
                    End With
            End Select
        Next
    Next
Exit Sub
errorhandler:
End Sub

读取分组对象中的文本

1 个答案: