Macro to remove custom styles from OpenOffice documents

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