流编辑OpenXml powerpoint演示幻灯片

时间:2018-04-11 04:25:48

标签: vb.net powerpoint openxml streamreader streamwriter

我正在尝试使用OpenXml和Streamreader / Streamwriter编辑Powerpoint幻灯片的XML流。

对于word文档,很容易:

Imports System.IO
Imports DocumentFormat.OpenXml
Imports DocumentFormat.OpenXml.Packaging
Imports DocumentFormat.OpenXml.Presentation
Imports DocumentFormat.OpenXml.Wordprocessing

'  
'
'
' Open a word document
CurrentOpenDocument = WordprocessingDocument.Open(TheWordFileName, True)

' for a word document, this works

Using (CurrentOpenDocument)
    ' read the xml stream
    Dim sr As StreamReader = New StreamReader(CurrentOpenDocument.MainDocumentPart.GetStream)
    docText = sr.ReadToEnd
    ' do the substitutions here
    docText = DoSubstitutions(docText)

    ' write the modified xml stream
    Dim sw As StreamWriter = New StreamWriter(CurrentOpenDocument.MainDocumentPart.GetStream(FileMode.Create))
    Using (sw)
        sw.Write(docText)
    End Using

End Using

但是对于Powerpoint(演示文稿),我发现为slideparts插入的修改后的XML流不会被保存:

Imports System.IO
Imports DocumentFormat.OpenXml
Imports DocumentFormat.OpenXml.Packaging
Imports DocumentFormat.OpenXml.Presentation
Imports DocumentFormat.OpenXml.Wordprocessing

'                    
'
' Open a powerpoint presentation 
CurrentOpenPresentation = PresentationDocument.Open(ThePowerpointFileName, True)

' for a powerpoint presentation, this doesn't work
Using (CurrentOpenPresentation)

    ' Get the presentation part of the presentation document.
    Dim pPart As PresentationPart = CurrentOpenPresentation.PresentationPart

    ' Verify that the presentation part and presentation exist.
    If pPart IsNot Nothing AndAlso pPart.Presentation IsNot Nothing Then
        ' Get the Presentation object from the presentation part.
        Dim pres As Presentation = pPart.Presentation

        ' Verify that the slide ID list exists.
        If pres.SlideIdList IsNot Nothing Then
            ' Get the collection of slide IDs from the slide ID list.
            Dim slideIds = pres.SlideIdList.ChildElements

            ' loop through each slide
            For Each sID In slideIds
                Dim slidePartRelationshipId As String = (TryCast(sID, SlideId)).RelationshipId
                Dim TheslidePart As SlidePart = CType(pPart.GetPartById(slidePartRelationshipId), SlidePart)
                ' If the slide exists...
                If TheslidePart.Slide IsNot Nothing Then

                    Dim sr As StreamReader = New StreamReader(TheslidePart.GetStream)
                    Using (sr)
                        docText = sr.ReadToEnd
                    End Using
                    docText = DoSubstitutions(docText)

                    Dim sw As StreamWriter = New StreamWriter(TheslidePart.GetStream(FileMode.Create))
                    Using (sw)
                        sw.Write(docText)
                    End Using

                End If
            Next
    End If
End Using

我还尝试迭代内存中的slideparts来检查XML流,并且它们已被更改。

只是这永远不会被保存回到dispose中的文件(最终使用),并且不会引发错误异常。

还有其他人经历过这个吗?

1 个答案:

答案 0 :(得分:1)

经过大约一周的讨论,我找到了答案。它是从集合中引用幻灯片而不是通过关系Id引用,虽然我不知道为什么这样做,而最初的方法却没有:

' This DOES work
Using (CurrentOpenPresentation)
    ' Get the presentation part of the presentation document.
    Dim pPart As PresentationPart = CurrentOpenPresentation.PresentationPart

    ' Verify that the presentation part and presentation exist.
    If pPart IsNot Nothing AndAlso pPart.Presentation IsNot Nothing Then

        ' reference each slide in turn and do the Substitution
        For Each s In pPart.SlideParts
            Dim sr As StreamReader = New StreamReader(s.GetStream)
            Using (sr)
                docText = sr.ReadToEnd
            End Using
            docText = DoSubstitutions(docText)

            Dim sw As StreamWriter = New StreamWriter(s.GetStream(FileMode.Create))
            Using (sw)
                sw.Write(docText)
            End Using
        Next
    End If
End Using