Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
OpenOffice macros. Makes all images in .odt file available offline.
Sub Main
'Inspect ThisComponent.getDrawPage()
ConvertAllLinkedGraphics
End Sub
Sub ConvertAllLinkedGraphics(Optional aDoc)
Dim oDoc ' Working document
Dim oDP ' Draw page
Dim i% ' Index counter
Dim oGraph ' Graph object in the draw page
Dim iLinked% ' Number of linked graphics
Dim iEmbedded% ' Number of embedded graphics
Dim iConverted% ' Linked graphics converted to embedded
Dim s1$ ' Graphic service name
Dim s2$ ' Graphic service name
REM Only know how to convert these types
s1 = "com.sun.star.drawing.GraphicObjectShape"
s2 = "com.sun.star.text.TextGraphicObject"
If IsMissing(aDoc) OR IsNull(aDoc) OR IsEmpty(aDoc) Then
oDoc = ThisComponent
Else
oDoc = aDoc
End If
REM Get the document draw page and then enumerate the graphics.
oDP = oDoc.getDrawPage()
For i=0 To oDP.getCount()-1
oGraph = oDP.getByIndex(i)
If oGraph.supportsService(s1) OR oGraph.supportsService(s2) Then
If InStr(oGraph.GraphicURL, "vnd.sun") <> 0 Then
iEmbedded = iEmbedded + 1
Else
iLinked = iLinked + 1
If EmbedLinkedGraphic_2(oGraph, oDoc) Then
iConverted = iConverted + 1
End If
End If
End If
Next
Print "Found " & iLinked & " linked and " & iEmbedded & _
" embedded graphics and converted " & iConverted
End Sub
' oDoc - document to contain the image.
' oCurs - Cursor where the image is added
' sURL - URL of the image to insert.
' sParStyle - set the paragraph style to this.
Sub EmbedGraphic(oDoc, oCurs, sURL$, sParStyle$)
Dim oShape
Dim oGraph 'The graphic object is text content.
Dim oProvider 'GraphicProvider service.
Dim oText
oShape = oDoc.createInstance("com.sun.star.drawing.GraphicObjectShape")
oGraph = oDoc.createInstance("com.sun.star.text.GraphicObject")
oDoc.getDrawPage().add(oShape)
oProvider = createUnoService("com.sun.star.graphic.GraphicProvider")
Dim oProps(0) as new com.sun.star.beans.PropertyValue
oProps(0).Name = "URL"
oProps(0).Value = sURL
REM Save the original size.
Dim oSize100thMM
Dim lHeight As Long
Dim lWidth As Long
oSize100thMM = RecommendGraphSize(oProvider.queryGraphicDescriptor(oProps))
If NOT IsNull(oSize100thMM) AND NOT IsEmpty(oSize100thMM) Then
lHeight = oSize100thMM.Height
lWidth = oSize100thMM.Width
End If
oShape.Graphic = oProvider.queryGraphic(oProps())
oGraph.graphicurl = oShape.graphicurl
oGraph.AnchorType = com.sun.star.text.TextContentAnchorType.AS_CHARACTER
oText= oCurs.getText()
oText.insertTextContent(oCurs, oGraph, false)
oDoc.getDrawPage().remove(oShape)
If lHeight > 0 AND lWidth > 0 Then
Dim oSize
oSize = oGraph.Size
oSize.Height = lHeight
oSize.Width = lWidth
oGraph.Size = oSize
End If
' Set the paragraph style if it is in the document.
Dim oStyles
oStyles = oDoc.StyleFamilies.getByName("ParagraphStyles")
If oStyles.hasByName(sParStyle) Then
oCurs.ParaStyleName = sParStyle
End If
End Sub
Function EmbedLinkedGraphic_2(oGraph, oDoc) As Boolean
REM Author: Andrew Pitonyak
Dim sGraphURL$ ' External URL of the graphic.
Dim oGraph_2 ' Created graphic.
Dim oCurs ' Cursor where the graphic is located.
Dim oText ' Text object containing graphic.
Dim oAnchor ' Anchor point of the image
Dim s1$ ' Graphic service name
Dim s2$ ' Graphic service name
EmbedLinkedGraphic_2 = False
If InStr(oGraph.GraphicURL, "vnd.sun") <> 0 Then
REM Ignore an image that is already embedded
Exit Function
End If
s1 = "com.sun.star.drawing.GraphicObjectShape"
s2 = "com.sun.star.text.TextGraphicObject"
If oGraph.supportsService(s1) Then
REM I only know how to convert a GraphicObjectShape.
REM I do not know how to convert a TextGraphicObject,
REM but it is probably related to the ImageMap attribute.
oAnchor = oGraph.getAnchor()
oText = oAnchor.getText()
oGraph_2 = ThisComponent.createInstance(s)
oGraph_2.GraphicObjectFillBitmap = oGraph.GraphicObjectFillBitmap
oGraph_2.Size = oGraph.Size
oGraph_2.Position = oGraph.Position
oText.insertTextContent(oAnchor, oGraph_2, False)
oText.removeTextContent(oGraph)
EmbedLinkedGraphic_2 = True
ElseIf oGraph.supportsService(s2) Then
Dim oBitmaps
Dim sNewURL$
Dim sName$
sName$ = oGraph.LinkDisplayName
oBitmaps = oDoc.createInstance( "com.sun.star.drawing.BitmapTable" )
If oBitMaps.hasByName(sName) Then
Print "Link display name " & sName & " already exists"
Exit Function
End If
'Print "Ready to insert (" & sName & ") with URL " & oGraph.GraphicURL
oBitmaps.insertByName( sName, oGraph.GraphicURL )
'Print "inserted " & sName
'Inspect oBitMaps
'MsgBox Join(CHR$(10), oBitmaps.getElementNames())
sNewURL$ = oBitmaps.getByName( sName )
'Print "inserted URL " & sNewURL
oGraph.GraphicURL = sNewURL
EmbedLinkedGraphic_2 = True
End If
End Function
Function RecommendGraphSize(oGraph)
Dim oSize
Dim lMaxW As Double ' Maximum width in 100th mm
Dim lMaxH As Double ' Maximum height in 100th mm
lMaxW = 6.75 * 2540 ' 6.75 inches
lMaxH = 9.5 * 2540 ' 9.5 inches
If IsNull(oGraph) OR IsEmpty(oGraph) Then
Exit Function
End If
oSize = oGraph.Size100thMM
If oSize.Height = 0 OR oSize.Width = 0 Then
' 2540 is 25.40 mm in an inch, but I need 100th mm.
' There are 1440 twips in an inch
oSize.Height = oGraph.SizePixel.Height * 2540.0 * TwipsPerPixelY() / 1440
oSize.Width = oGraph.SizePixel.Width * 2540.0 * TwipsPerPixelX() / 1440
End If
If oSize.Height = 0 OR oSize.Width = 0 Then
'oSize.Height = 2540
'oSize.Width = 2540
Exit Function
End If
If oSize.Width > lMaxW Then
oSize.Height = oSize.Height * lMaxW / oSize.Width
oSize.Width = lMaxW
End If
If oSize.Height > lMaxH Then
oSize.Width = oSize.Width * lMaxH / oSize.Height
oSize.Height = lMaxH
End If
RecommendGraphSize = oSize
End Function
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.