REM ***** BASIC ***** Option Explicit Sub SetBulletGraphics(sBulletUrl as String) Dim i as Integer Dim oBookMarkCursor as Object oBookmarks = oBaseDocument.BookMarks For i = 0 To oBookmarks.Count - 1 oBookMark = oBookmarks.GetbyIndex(i) oBookMarkCursor = oBookMark.Anchor.Text.CreateTextCursorByRange(oBookMark.Anchor) If oBookMarkCursor.PropertySetInfo.HasPropertybyName("NumberingRules") Then ChangeBulletURL(sBulletUrl, oBookMarkCursor) End If Next i End Sub Sub ChangeBulletURL(sBulletUrl as String, oBookMarkCursor as Object) Dim n, m as Integer Dim oLevel() Dim oRules Dim bDoReplace as Boolean Dim oSize as New com.sun.star.awt.Size Dim oNumberingBuffer(0) as New com.sun.star.beans.PropertyValue Dim oNewBuffer(0) as New com.sun.star.beans.PropertyValue oRules = oBookMarkCursor.NumberingRules If Vartype(oRules()) = 9 Then oNumberingBuffer(0).Name = "NumberingType" oNumberingBuffer(0).Value = com.sun.star.style.NumberingType.BITMAP For n = 0 To oRules.Count - 1 oLevel() = oRules.GetByIndex(n) bDoReplace = ModifyPropertyValue(oLevel(), oNumberingBuffer()) If bDoReplace Then oRules.ReplaceByIndex(n, oNumberingBuffer()) End If Next n oBookmarkCursor.NumberingRules = oRules oNewBuffer(0).Name = "GraphicURL" oNewBuffer(0).Value = sBulletUrl For n = 0 To oRules.Count - 1 oLevel() = oRules.GetByIndex(0) bDoReplace = ModifyPropertyValue(oLevel(), oNewBuffer()) If bDoReplace Then oRules.ReplaceByIndex(n, oNewBuffer()) End If Next n oBookmarkCursor.NumberingRules = oRules End If End Sub Sub BulletUrlsToSavePath(SavePath as String) Dim n as Integer Dim m as Integer Dim i as Integer Dim sNewBulletUrl as String Dim oLevel() Dim oRules Dim bIsFirstRun as Boolean Dim oNewBuffer()' as New com.sun.star.beans.PropertyValue Dim bDoReplace as Boolean Dim oBookmarkCursor as Object bIsFirstRun = True oBookmarks = oBaseDocument.BookMarks For i = 0 To oBookmarks.Count - 1 oBookMark = oBookmarks.GetbyIndex(i) oBookMarkCursor = oBookMark.Anchor.Text.CreateTextCursorByRange(oBookMark.Anchor) If oBookMarkCursor.PropertySetInfo.HasPropertybyName("NumberingRules") Then oRules = oBookMarkCursor.NumberingRules If Vartype(oRules()) = 9 Then For n = 0 To oRules.Count - 1 oLevel() = oRules.GetByIndex(n) oNewBuffer() = ChangeBulletUrlToSavePath(SavePath, oLevel(), bIsFirstRun, bDoReplace) If bDoReplace Then bIsFirstRun = False oRules.ReplaceByIndex(n, oNewBuffer()) End If Next n oBookmarkCursor.NumberingRules = oRules End If End If Next i End Sub Function ChangeBulletUrlToSavePath(SavePath as String, oLevel(), bIsFirstRun as Boolean, bDoReplace as Boolean) Dim MaxIndex as Integer Dim i as Integer Dim BulletName as String Dim oSize as New com.sun.star.awt.Size MaxIndex = Ubound(oLevel()) Dim oNewBuffer(MaxIndex) as New com.sun.star.beans.PropertyValue For i = 0 To MaxIndex oNewBuffer(i).Name = oLevel(i).Name If oLevel(i).Name = "GraphicURL" Then bDoReplace = True BulletName = FileNameoutofPath(oLevel(i).Value) If bIsFirstRun Then If oUcb.exists(SavePath & Bulletname) Then FileCopy(oLevel(i).Value, SavePath & BulletName) End If End If oNewBuffer(i).Value = BulletName ' ElseIf oLevel(i).Name = "GraphicSize" Then '' Todo: Get the original Size of the Bullet (see Bug #86196) ' oSize.Height = 300 ' oSize.Width = 300 ' oNewBuffer(i).Value = oSize Else oNewBuffer(i).Value = oLevel(i).Value End If Next i ChangeBulletUrlToSavePath() = oNewBuffer() End Function