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