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

这根本不起作用，它完全忽略了子弹格式，但仍然输出没有*
的内容

导出图片：

原始代码

' 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

此代码会在Windows中抛出following error，在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中的每个段落，因为可以为整个文本范围或其中的特定段落设置项目符号，如果有混合，您将获得意外结果。我也不明白为什么要更换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

对于第二点，我得到了相同的错误，因为images子文件夹不存在。一旦我手动创建它，代码就在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中将段落格式标识为项目符号时出错

1 个答案: