Hello,
> From: Jörg Schmidt [mailto:joe...@j-m-schmidt.de]
> Thank You. The following works for me:
>
> Sub Vorlage_kopieren()
> ...
I use the same for numberingstyles it does not work properly.
Using the following code will _not_ transfer the setting "position-at" (in a
german AOO "Position-bei") of an numbering style.
Sub Vorlage_kopieren()
On Local Error Goto ErrorHandler
Dim oDocument as Object
Dim oSheet as Object
Dim oPStyle as Object
Dim oStyles as Object
Dim oCpyStyle as Object
Dim aProperties as Object
Dim vTmp as Variant
Dim sCopy as String
Dim sX as String
Dim i as Integer
oDocument = ThisComponent
oStyles = oDocument.StyleFamilies.getByName("NumberingStyles")
oPStyle = oStyles.getByName("jms1")
sCopy = "jms2"
oCpyStyle =
oDocument.createInstance("com.sun.star.style.NumberingStyle")
If oStyles.hasByName(sCopy) Then
oStyles.removeByName(sCopy)
EndIf
oStyles.insertByName(sCopy, oCpyStyle)
aProperties = oPStyle.PropertySetInfo.Properties
'XrayTool.XRAY(oPStyle)
For i = LBound(aProperties) to UBound(aProperties)
sX = aProperties(i).Name
'kk = kk & aProperties(i).Name & "|"
If Not IsNull(sX) Then
If sX <> "" Then
If oPStyle.getPropertyState(sX) =
com.sun.star.beans.PropertyState.DIRECT_VALUE Then
vTmp = oPStyle.getPropertyValue(sX)
oCpyStyle.setPropertyValue(sX, vTmp)
EndIf
EndIf
EndIf
Next i
'Msgbox kk
Exit Sub
ErrorHandler:
msgbox Erl & "|" & Error & "|" & Err
Resume Next
End Sub
Greetings,
Jörg
---------------------------------------------------------------------
To unsubscribe, e-mail: api-unsubscr...@openoffice.apache.org
For additional commands, e-mail: api-h...@openoffice.apache.org
