使用 shape.export 在 powerpoint 中提取图像并在 VBA 中将段落格式识别为项目符号时出错

Question

我重新调整了 MicrosoftPowerpointConverter - MoinMoin 上的代码的用途，以便在没有 Microsoft Scripting Runtime 的情况下工作。

我能够生成一个新文件并将文本导出到它，（我知道这是最简单的部分），我被卡在两个地方：

格式化项目符号：

原码

' Check for bullets
If aShape.TextFrame.TextRange.ParagraphFormat.Bullet = msoTrue Then
    outText = Replace(outText, Chr(10), " * ")
End If

我的代码

' Check for bullets
If oShape.TextFrame.TextRange.ParagraphFormat.Bullet.Type <> ppBulletNone Then
     outText = Replace(outText, Chr(10), " * ")
End If

This doesn't work at all, and it totally ignores bullet formatting, but still outputs the content without the *

正在导出图像：

原码

' Is it a picture or embedded object
If aShape.Type = msoPicture Or aShape.Type = msoEmbeddedOLEObject Or aShape.Type = msoLinkedPicture Or aShape.Type = msoGroup Then
    aShape.Export outPath + "\image" + Trim(Str(i)) + Trim(Str(j)) + ".png", ppShapeFormatPNG
    oFileStream.WriteLine (Chr(13) + "attachment:image" + Trim(Str(i)) + Trim(Str(j)) + ".png" + Chr(13))
End If

我的代码

' Is it a picture or embedded object
If oShape.Type = msoPicture Or oShape.Type = msoEmbeddedOLEObject Or oShape.Type = msoLinkedPicture Or oShape.Type = msoGroup Then
    Dim imagepath
    imagepath = oPres.Path & "/images/slide" + Trim(Str(i)) + Trim(Str(j)) + ".png"
    oShape.Export imagepath, ppShapeFormatPNG
    Print #iFile, (Chr(13) + "<img src=" + Chr(34) + "/images/slide" + Trim(Str(i)) + Trim(Str(j)) + ".png" + Chr(34) + ">" + Chr(13))
End If

This code throws up the following error in windows, and is totally ignored in Mac

在下面添加我的完整代码：

Sub ExportToWiki()



' Iterators
Dim i As Integer
Dim j As Integer

' Pres, Slide, Shape
Dim oPres As Presentation
Dim oSlides As Slides
Dim oSlide 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


Set oPres = ActivePresentation
Set oSlides = oPres.Slides

FileNum = FreeFile

'Open output file
' NOTE:  errors here if file hasn't been saved
Open oPres.Path & "/text.xml" For Output As FileNum

' File Handling
Dim outText As String

' Table exports
Dim row As Integer
Dim col As Integer
Dim cellText As String


' Select my ppt

' Write TOC
Print #iFile, ("[[TableOfContents]]")

' Loop through slides
For i = 1 To oPres.Slides.Count

    Set oSlide = oPres.Slides(i)

    ' Loop through shapes
    For j = 1 To oSlide.Shapes.Count

        Set oShape = oSlide.Shapes(j)

        ' Is it a text frame?
        If oShape.HasTextFrame Then

            If oShape.TextFrame.HasText Then

                outText = oShape.TextFrame.TextRange.Text

                ' Check for bullets
                If oShape.TextFrame.TextRange.ParagraphFormat.Bullet.Type <> ppBulletNone Then
                    outText = Replace(outText, Chr(10), " * ")
                End If

                If j = 1 Then ' Assume first text is always the header
                    outText = "= " + outText + " ="
                 End If

                 Print #iFile, (outText + Chr(13) + "[[BR]]" + Chr(13))

            End If

        End If

        ' Is it a table?
        If oShape.Type = msoTable Then

            cellText = ""

            For row = 1 To oShape.Table.Rows.Count
                For col = 1 To oShape.Table.Columns.Count

                    If row = 1 Then
                        cellText = cellText + "||<class=" + Chr(34) + "tableheader" + Chr(34) + ">" + oShape.Table.Columns.Item(col).Cells(row).Shape.TextFrame.TextRange.Text
                    Else
                        cellText = cellText + "||" + oShape.Table.Columns.Item(col).Cells(row).Shape.TextFrame.TextRange.Text
                    End If

                    If col = oShape.Table.Columns.Count Then
                        cellText = cellText + "||" + Chr(13)
                    End If

                Next col
            Next row

            Print #iFile, (Chr(13) + cellText + Chr(13))

        End If

        ' Is it a picture or embedded object
        If oShape.Type = msoPicture Or oShape.Type = msoEmbeddedOLEObject Or oShape.Type = msoLinkedPicture Or oShape.Type = msoGroup Then
            Dim imagepath
            imagepath = oPres.Path & "/images/slide" + Trim(Str(i)) + Trim(Str(j)) + ".png"
            oShape.Export imagepath, ppShapeFormatPNG
            Print #iFile, (Chr(13) + "<img src=" + Chr(34) + "/images/slide" + Trim(Str(i)) + Trim(Str(j)) + ".png" + Chr(34) + ">" + Chr(13))
        End If

    Next j
Next i

Close #iFile

End Sub

Answer 1

对于第一部分，我认为您可能需要递归检查 TextRange 中的每个段落，因为可以为整个文本运行ge 或其中的特定段落设置项目符号，如果有混合，你会得到意想不到的结果。我也不明白为什么要替换 Char 10。我认为您应该返回找到项目符号的段落的文本，并在其前面加上您的 Wiki 字符串。例如：

' Check for bullets
Dim p As Long
Dim para As String
With oShape.TextFrame.TextRange
  For p = 1 To .Paragraphs.Count
    If .Paragraphs(p).ParagraphFormat.Bullet.Type <> ppBulletNone Then
      para = " * " & .Paragraphs(p).Text
    Else
      para = .Paragraphs(p).Text
    End If
    outText = outText & para
  Next
End With

对于第二点，我得到了同样的错误，因为图像子文件夹不存在。一旦我手动创建它，PC 上的代码运行。对于 Mac，如果我没记错的话，你需要使用 POSIX 或 AppleScript 路径语法，例如：

#If Mac Then
  Public Const PathSeparator = ":"
#Else
  Public Const PathSeparator = "\"
#End If

但是，如果您使用的是 PowerPoint:mac 2016，那么由于其沙盒环境，事情会更加复杂。查看这篇文章以获取更多信息：

http://www.rondebruin.nl/mac/mac034.htm

使用 shape.export 在 powerpoint 中提取图像并在 VBA 中将段落格式识别为项目符号时出错

Error extracting images in powerpoint using shape.export and identifying paragraph format as bullets in VBA

powerpoint

vba