none
Copying a template Autotext with image to another document looses image relation RRS feed

  • Question

  • Hi

    I'm working on a Webservice project to replace Office Automation(since this no longer is supported).

    In the project I'm creating a new document out of a template.
    The template consists of a number of AutoTexts, which holds different Headers and Footers for the document.
    I have now a function which succesfully copies the AutoText-part using InnerXML from the template to the documents Header/Footer.

    But, some of the Headers contains an image (logotype), and with my approach the relation to the image and the image itself is not copied to the document.
    In the resulting docs XML-code I can see the referens ID in the Header.xml file, but the ID is not in the rels-document and the image is not in the /media-folder.

    How can the relationsship and the image be transfered in my process.


    Best Regards Peter Karlström Midrange AB, Sweden

    Friday, January 25, 2013 8:27 AM

Answers

  • Hi Peter

    Here's a sample (Console app) that checks for one specific type of graphic - <a:blip> - and brings it across. This code also creates a default header in the target document if none is present and creates the Header style in the target document if it's not already present. Note the Imports at the top of the code!

    Imports DocumentFormat.OpenXml.Drawing
    Module Module1
    
        Sub Main()
            CreateHeaderFromAutoText()
        End Sub
    
        Private Sub CreateHeaderFromAutoText()
    
            Dim targetPath As String = "C:\Test\AddHeaderFormAT_NoHeader.docx" '// @"C:\Test\TestCopiedHeaderFromAT.docx"
            Dim sourcePath As String = "C:\Test\TestOXML_BB.dotx"
    
            Using sourcePkg As WordprocessingDocument = WordprocessingDocument.Open(sourcePath, False)
    
                Dim mainSourcePart As MainDocumentPart = sourcePkg.MainDocumentPart
                If (mainSourcePart.GetPartsCountOfType(Of GlossaryDocumentPart)() > 0) Then
                    'Read the header information from the AutoText
                    Dim glossDoc As GlossaryDocument = mainSourcePart.GetPartsOfType(Of GlossaryDocumentPart).FirstOrDefault().GlossaryDocument
                    Dim glossPart As DocPart = glossDoc.Descendants(Of DocPart).Where(Function(g As DocPart) g.DocPartProperties.DocPartName.Val.ToString() = "HeaderTestWithGraphic").FirstOrDefault()
                    Dim headerXML As String = glossPart.DocPartBody.InnerXml
    
                    'Read the style information for the the 'Header' style stored in the AutoText
                    'In this example we're assuming that's the only style used to format the entry
                    Dim glossStyle As StyleDefinitionsPart = mainSourcePart.GetPartsOfType(Of GlossaryDocumentPart).FirstOrDefault().StyleDefinitionsPart
                    Dim hStyle As Style = glossStyle.Styles.Descendants(Of Style).Where(Function(s As Style) s.StyleId.Value.ToString() = "Header").FirstOrDefault()
                    Dim paraProps As StyleParagraphProperties = hStyle.StyleParagraphProperties
                    Dim runProps As StyleRunProperties = hStyle.StyleRunProperties
    
                    'Check for any linked graphics in the header
                    Dim sourceBlips As IEnumerable(Of DocumentFormat.OpenXml.Drawing.Blip) = glossPart.DocPartBody.Descendants(Of DocumentFormat.OpenXml.Drawing.Blip)()
                    Using targetPkg As WordprocessingDocument = WordprocessingDocument.Open(targetPath, True)
                        Dim mainTargetPart As MainDocumentPart = targetPkg.MainDocumentPart
                        Dim docStyle As StyleDefinitionsPart = mainTargetPart.StyleDefinitionsPart
                        Dim hTargetStyle As Style = docStyle.Styles.Descendants(Of Style).Where(Function(s As Style) s.StyleId.Value.ToString() = "Header").FirstOrDefault()
                        If hTargetStyle Is Nothing Then
                            hTargetStyle = New Style With {.StyleId = "Header", .StyleParagraphProperties = New StyleParagraphProperties, .StyleRunProperties = New StyleRunProperties, .Default = 1, .Type = StyleValues.Paragraph}
                            hTargetStyle.StyleName = New StyleName With {.Val = "header"}
                            docStyle.Styles.Append(hTargetStyle)
                        End If
                        Dim paraTargetProps As StyleParagraphProperties = hTargetStyle.StyleParagraphProperties
                        Dim runTargetProps As StyleRunProperties = hTargetStyle.StyleRunProperties
                        paraTargetProps.InnerXml = paraProps.InnerXml
                        runTargetProps.InnerXml = runProps.InnerXml
    
                        Dim hPart As HeaderPart = mainTargetPart.HeaderParts.FirstOrDefault()
                        If (hPart Is Nothing) Then
                            hPart = AddHeaderPart(targetPkg)
                        End If
                        Dim h As Header = hPart.Header
                        h.InnerXml = headerXML
    
                        If sourceBlips.Count > 0 Then
                            Dim sourceBlip As DocumentFormat.OpenXml.Drawing.Blip = Nothing
                            For Each sourceBlip In sourceBlips
                                Dim imgPart As ImagePart = glossDoc.GlossaryDocumentPart.GetPartById(sourceBlip.Embed)
                                Dim imgTargetPart As ImagePart = hPart.AddImagePart(imgPart.ContentType)
                                imgTargetPart.FeedData(imgPart.GetStream())
                                Dim targetBlip As Blip = h.Descendants(Of Blip).Where(Function(b As Blip) b.Embed.Value = sourceBlip.Embed.Value).FirstOrDefault()
                                targetBlip.Embed = hPart.GetIdOfPart(imgTargetPart)
                            Next
                        End If
                    End Using
                Else
                    Console.WriteLine("No Glossary part found.")
                    Console.ReadLine()
                End If
            End Using
        End Sub
    
        'Create a new default header for the document without content
        'Content will be added in the calling procedure
        Private Function AddHeaderPart(ByVal wdPkgTarget As WordprocessingDocument) As HeaderPart
    
            Dim newHeaderPart As HeaderPart = wdPkgTarget.MainDocumentPart.AddNewPart(Of HeaderPart)()
            Dim hrID As String = wdPkgTarget.MainDocumentPart.GetIdOfPart(newHeaderPart)
            newHeaderPart.Header = New Header()
            Dim hr As HeaderReference = New HeaderReference With {.Type = HeaderFooterValues.Default, .Id = hrID}
            Dim docTarget As Document = wdPkgTarget.MainDocumentPart.Document
            docTarget.Body.Elements(Of SectionProperties).LastOrDefault().InsertAt(hr, 0)
            Return newHeaderPart
        End Function
    End Module


    Cindy Meister, VSTO/Word MVP, my blog

    Friday, January 25, 2013 6:23 PM
    Moderator

All replies

  • Hi Peter

    Here's a sample (Console app) that checks for one specific type of graphic - <a:blip> - and brings it across. This code also creates a default header in the target document if none is present and creates the Header style in the target document if it's not already present. Note the Imports at the top of the code!

    Imports DocumentFormat.OpenXml.Drawing
    Module Module1
    
        Sub Main()
            CreateHeaderFromAutoText()
        End Sub
    
        Private Sub CreateHeaderFromAutoText()
    
            Dim targetPath As String = "C:\Test\AddHeaderFormAT_NoHeader.docx" '// @"C:\Test\TestCopiedHeaderFromAT.docx"
            Dim sourcePath As String = "C:\Test\TestOXML_BB.dotx"
    
            Using sourcePkg As WordprocessingDocument = WordprocessingDocument.Open(sourcePath, False)
    
                Dim mainSourcePart As MainDocumentPart = sourcePkg.MainDocumentPart
                If (mainSourcePart.GetPartsCountOfType(Of GlossaryDocumentPart)() > 0) Then
                    'Read the header information from the AutoText
                    Dim glossDoc As GlossaryDocument = mainSourcePart.GetPartsOfType(Of GlossaryDocumentPart).FirstOrDefault().GlossaryDocument
                    Dim glossPart As DocPart = glossDoc.Descendants(Of DocPart).Where(Function(g As DocPart) g.DocPartProperties.DocPartName.Val.ToString() = "HeaderTestWithGraphic").FirstOrDefault()
                    Dim headerXML As String = glossPart.DocPartBody.InnerXml
    
                    'Read the style information for the the 'Header' style stored in the AutoText
                    'In this example we're assuming that's the only style used to format the entry
                    Dim glossStyle As StyleDefinitionsPart = mainSourcePart.GetPartsOfType(Of GlossaryDocumentPart).FirstOrDefault().StyleDefinitionsPart
                    Dim hStyle As Style = glossStyle.Styles.Descendants(Of Style).Where(Function(s As Style) s.StyleId.Value.ToString() = "Header").FirstOrDefault()
                    Dim paraProps As StyleParagraphProperties = hStyle.StyleParagraphProperties
                    Dim runProps As StyleRunProperties = hStyle.StyleRunProperties
    
                    'Check for any linked graphics in the header
                    Dim sourceBlips As IEnumerable(Of DocumentFormat.OpenXml.Drawing.Blip) = glossPart.DocPartBody.Descendants(Of DocumentFormat.OpenXml.Drawing.Blip)()
                    Using targetPkg As WordprocessingDocument = WordprocessingDocument.Open(targetPath, True)
                        Dim mainTargetPart As MainDocumentPart = targetPkg.MainDocumentPart
                        Dim docStyle As StyleDefinitionsPart = mainTargetPart.StyleDefinitionsPart
                        Dim hTargetStyle As Style = docStyle.Styles.Descendants(Of Style).Where(Function(s As Style) s.StyleId.Value.ToString() = "Header").FirstOrDefault()
                        If hTargetStyle Is Nothing Then
                            hTargetStyle = New Style With {.StyleId = "Header", .StyleParagraphProperties = New StyleParagraphProperties, .StyleRunProperties = New StyleRunProperties, .Default = 1, .Type = StyleValues.Paragraph}
                            hTargetStyle.StyleName = New StyleName With {.Val = "header"}
                            docStyle.Styles.Append(hTargetStyle)
                        End If
                        Dim paraTargetProps As StyleParagraphProperties = hTargetStyle.StyleParagraphProperties
                        Dim runTargetProps As StyleRunProperties = hTargetStyle.StyleRunProperties
                        paraTargetProps.InnerXml = paraProps.InnerXml
                        runTargetProps.InnerXml = runProps.InnerXml
    
                        Dim hPart As HeaderPart = mainTargetPart.HeaderParts.FirstOrDefault()
                        If (hPart Is Nothing) Then
                            hPart = AddHeaderPart(targetPkg)
                        End If
                        Dim h As Header = hPart.Header
                        h.InnerXml = headerXML
    
                        If sourceBlips.Count > 0 Then
                            Dim sourceBlip As DocumentFormat.OpenXml.Drawing.Blip = Nothing
                            For Each sourceBlip In sourceBlips
                                Dim imgPart As ImagePart = glossDoc.GlossaryDocumentPart.GetPartById(sourceBlip.Embed)
                                Dim imgTargetPart As ImagePart = hPart.AddImagePart(imgPart.ContentType)
                                imgTargetPart.FeedData(imgPart.GetStream())
                                Dim targetBlip As Blip = h.Descendants(Of Blip).Where(Function(b As Blip) b.Embed.Value = sourceBlip.Embed.Value).FirstOrDefault()
                                targetBlip.Embed = hPart.GetIdOfPart(imgTargetPart)
                            Next
                        End If
                    End Using
                Else
                    Console.WriteLine("No Glossary part found.")
                    Console.ReadLine()
                End If
            End Using
        End Sub
    
        'Create a new default header for the document without content
        'Content will be added in the calling procedure
        Private Function AddHeaderPart(ByVal wdPkgTarget As WordprocessingDocument) As HeaderPart
    
            Dim newHeaderPart As HeaderPart = wdPkgTarget.MainDocumentPart.AddNewPart(Of HeaderPart)()
            Dim hrID As String = wdPkgTarget.MainDocumentPart.GetIdOfPart(newHeaderPart)
            newHeaderPart.Header = New Header()
            Dim hr As HeaderReference = New HeaderReference With {.Type = HeaderFooterValues.Default, .Id = hrID}
            Dim docTarget As Document = wdPkgTarget.MainDocumentPart.Document
            docTarget.Body.Elements(Of SectionProperties).LastOrDefault().InsertAt(hr, 0)
            Return newHeaderPart
        End Function
    End Module


    Cindy Meister, VSTO/Word MVP, my blog

    Friday, January 25, 2013 6:23 PM
    Moderator
  • HI Peter

    Apparently, Tom Xu has marked this as an answer without waiting for your reaction. As my reply was the only message in this thread, due to a forum software change, I'm not able to unmark it. I'm hoping this reply will allow me to do so, but if I can't, do feel free to reply in this thread if there's more to discuss...


    Cindy Meister, VSTO/Word MVP, my blog

    Monday, January 28, 2013 9:41 AM
    Moderator
  • Hi Cindy

    Thanks you. Much appreciated.

    I will look into your suggestion first thing in the morning.


    Best Regards Peter Karlström Midrange AB, Sweden

    Monday, January 28, 2013 5:47 PM
  • Hi Cindy

    This works splendidly! Thanks a million.


    Best Regards Peter Karlström Midrange AB, Sweden

    Tuesday, January 29, 2013 7:44 AM