Delete custom styles

Creating Extension - Shared Libraries
Forum rules
For sharing working examples of macros / scripts. These can be in any script language supported by OpenOffice.org [Basic, Python, Netbean] or as source code files in Java or C# even - but requires the actual source code listing. This forum is not for asking questions about writing your own macros.

Delete custom styles

Postby JohnV » Wed Feb 06, 2008 4:49 pm

You can not delete OOo's predefined styles but the following macro will delete custom (user defined) styles, of the type you choose whether those styles are in use or not. Current exception - custom List Styles (numbering & bullets) in use in a Table or Frame will not be deleted.
Code: Select all   Expand viewCollapse view
    Option Explicit
    Sub DeleteCustomStyles 'JohnV with Villeroy's dialog code. v1 February 6, 2008
    Dim ShowFirstMessage, ShowProgress, ShowDone, NumberStyle
    '>>>>>>>>>>>>>USER VARIABLES<<<<<<<<<<<<<<
    ShowFirstMessage = True     'Change to False to avoid 1st message.
    ShowProgress = True         'Change to False to avoid progress updates.
    ShowDone = True             'Change to False to avoid Done message.
    NumberStyle = "Numbering 1" 'Your preferred List Style (Case Sensitive).
    '>>>>>>>>>>>END USER VARIABLES<<<<<<<<<<<<
    Dim a,c,cc,oStyleType,NamesArray,StyleName,ThisStyle,cnt,checked as Boolean
    If ShowFirstMessage then
    a = "Remove custom styles?" & chr(13) & "You will get to choose the type of style."
    a = a & Chr(13) & "This will not affect OOo's predefined styles."
    If MsgBox(a,4,"Delete Custom Styles") = 7 then End
    EndIf
    'Start Villeroy's code.
    Dim sElements() as string, oFamilies, oFamily, sFamily$, sLabel, oDlg, i%
       oFamilies = thiscomponent.StyleFamilies
       sElements() = oFamilies.getElementNames()
       sLabel = "Pick one style family or <All>"& chr(10) _
             &"in order to remove all user defined (custom) styles"
       oDlg = getListboxDialog("Remove Custom Styles", sLabel, sElements())
       With oDlg.getControl("ListBox")
          .addItem("<All>",0)
          .selectItemPos(0,True)
       End With
       i = oDlg.execute()
       sFamily = oDlg.getControl("ListBox").getSelectedItem
       if i = 0 then
          exit sub
       endIf
    'End Villeroy's code.
    For c = 0 to uBound(oFamilies.ElementNames)
    oStyleType = oFamilies.getByName(oFamilies.ElementNames(c))
    If sFamily <> "<All>" and sFamily <> sElements(c) then goto SKIP
    NamesArray = oStyleType.getElementNames
    cnt = 0
    For cc = 0 to uBound(NamesArray)
      StyleName = NamesArray(cc)
      ThisStyle = oStyleType.getByName(StyleName)
      If ThisStyle.isUserDefined then
       If sElements(c) = "NumberingStyles" and ThisStyle.isInUse _
       and Not checked then
         checked = True
         Dim oDoc,NamesArray1,Used(),x,ts,n
         oDoc = ThisComponent
         NamesArray1 = oStyleType.getElementNames
         For x = 0 to uBound(NamesArray1)   
          ts = oStyleType.getByName(NamesArray1(x))
          If ts.isUserDefined and ts.isInUse then
           n = uBound(Used)+1
           ReDim Preserve Used(n)
           Used(n) = NamesArray1(x)
          EndIf
         Next x
        IterateParagraphs(oDoc,Used(),NumberStyle)
       EndIf
       oStyleType.removeByName(StyleName)
       cnt = cnt + 1
      EndIf
    Next cc
    If ShowProgress then
      a = "Deleted "& cnt &" custom style(s) of type " & sElements(c) & "."
      MsgBox a
    EndIf
    SKIP:
    Next c
    If ShowDone then MsgBox "Done."
    End Sub

    'Villeroy's code
    REM get a auto-sized dialog with title, label, listbox, OK and Cancel
    REM pass sFixedText with linebreaks Chr(10)
    Function getListboxDialog(sTitle$,sFixedText$,aListItems())
    Dim oDM,oDlg,oTools,oRegion,oRect,oPoint,oSz
       oDM = CreateUnoService("com.sun.star.awt.UnoControlDialogModel")
       oDM.Title = sTitle
       REM addAwtModel dialogModel, c.s.s.awt.UnoControl<type>, name of control,
       REM         (propertyNames), (propertyValues) !propertyNames in alpabetical order!
       addAwtModel oDM,"FixedText","FixedText", _
             Array("Label","MultiLine"), _
             Array(sFixedText,True)
       addAwtModel oDM,"ListBox","ListBox", _
             Array("Dropdown","StringItemList"), _
             Array(True,aListItems())
       addAwtModel oDM,"Button","btnOK", _
             Array("DefaultButton","Label","PushButtonType"), _
             Array(True,"OK",com.sun.star.awt.PushButtonType.OK)
       addAwtModel oDM,"Button","btnCancel", _
             Array("Label","PushButtonType"), _
             Array("Cancel",com.sun.star.awt.PushButtonType.CANCEL)
       oDlg = CreateUnoService("com.sun.star.awt.UnoControlDialog")
       oDlg.setModel(oDM)
       oDlg.setVisible(True)
       oTools = oDlg.getPeer.getToolkit
       oRegion = oTools.createRegion
       oPoint = createUnoStruct("com.sun.star.awt.Point")
       oPoint.X = 5
       oPoint.Y = 5
       oRect = stackVertically(oDlg,Array("FixedText","ListBox","btnOK","btnCancel"),oRegion,oPoint,5)
       oDlg.setPosSize(0,0, oRect.Width +oRect.X, oRect.Height +oRect.Y,com.sun.star.awt.PosSize.SIZE)
       getListboxDialog = oDlg
    End Function

    'Villery's code
    Sub addAwtModel(oDM,srv,sName,aNames(),aValues())
    Dim oCM
       oCM = oDM.createInstance("com.sun.star.awt.UnoControl"+ srv +"Model")
       oCM.setPropertyValues(aNames(),aValues())
       oDM.insertByName(sName,oCM)
    End Sub   

    'Villeroy's code
    Function getControlSize(oCtrl)
    '''Return preferred width and/or height, if not already set larger.'''
    Dim curPS, prefSz
       curPS = oCtrl.getPosSize()
       prefSz = oCtrl.getPreferredSize()
       if curPS.Width >= prefSz.Width  then prefSz.Width = curPS.Width
       if curPS.Height >= prefSz.Height then prefSz.Height = curPS.Height
    getControlSize = prefSz
    End Function

    'Villeroy's code
    Function stackVertically(oDlg,sNames(),oRegion,oPoint,optional spc)
    'calls: getControlSize
    '''Stack list of controls vertically, starting at point with optional spaces below.
    'Calculate and set preferred width and/or height if not already set >= preferredSize.
    'Out: resized oRegion with added rectangles.
    'Returns new bounds of region'''
    Dim y&, i%, s$, c, sz
       if isMissing(spc) then spc = 0
       y = oPoint.Y
       for i = 0 to uBound(sNames())
          s = sNames(i)
          c = oDlg.getControl(s)
          sz = getControlSize(c)
          c.setPosSize(oPoint.X, y, sz.Width, sz.Height, com.sun.star.awt.PosSize.POSSIZE)
          oRegion.unionRectangle(c.getPosSize())
          y = y +sz.Height +spc
       next
    stackVertically = oRegion.getBounds()
    End Function
    'End Villery's code.

    Sub IterateParagraphs(oDoc,Used(),NumberStyle)
    Dim enum,thisParagraph,c
    enum = oDoc.Text.createEnumeration
    While enum.hasMoreElements
    thisParagraph = enum.nextElement
    For c = 0 to uBound(Used)
      If Not thisParagraph.SupportsService("com.sun.star.text.TextTable") then
       If thisParagraph.NumberingStyleName = Used(c) then
        thisParagraph.NumberingStyleName = NumberStyle
       EndIf
      EndIf
    Next
    Wend
    End Sub
JohnV
Volunteer
 
Posts: 1585
Joined: Mon Oct 08, 2007 1:32 am
Location: Kentucky, USA

Re: Delete custom styles

Postby esperantisto » Fri Feb 22, 2008 3:50 pm

JohnV, I fail to find words to praise you :-)
AOO 4.2.0 / LibO 5.0.2.1 / Win 7 / openSUSE Linux 11.3 (32-bit) / 13.2 (64-bit)
esperantisto
Volunteer
 
Posts: 469
Joined: Mon Oct 08, 2007 1:31 am


Return to Code Snippets

Who is online

Users browsing this forum: No registered users and 1 guest