SHARE
TWEET

Macro to remove custom styles from OpenOffice documents

a guest Jul 10th, 2019 93 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Option Explicit
  2.     Sub DeleteCustomStyles 'JohnV with Villeroy's dialog code. v1 February 6, 2008
  3.     Dim ShowFirstMessage, ShowProgress, ShowDone, NumberStyle
  4.     '>>>>>>>>>>>>>USER VARIABLES<<<<<<<<<<<<<<
  5.     ShowFirstMessage = True     'Change to False to avoid 1st message.
  6.     ShowProgress = True         'Change to False to avoid progress updates.
  7.     ShowDone = True             'Change to False to avoid Done message.
  8.     NumberStyle = "Numbering 1" 'Your preferred List Style (Case Sensitive).
  9.     '>>>>>>>>>>>END USER VARIABLES<<<<<<<<<<<<
  10.     Dim a,c,cc,oStyleType,NamesArray,StyleName,ThisStyle,cnt,checked as Boolean
  11.     If ShowFirstMessage then
  12.     a = "Remove custom styles?" & chr(13) & "You will get to choose the type of style."
  13.     a = a & Chr(13) & "This will not affect OOo's predefined styles."
  14.     If MsgBox(a,4,"Delete Custom Styles") = 7 then End
  15.     EndIf
  16.     'Start Villeroy's code.
  17.     Dim sElements() as string, oFamilies, oFamily, sFamily$, sLabel, oDlg, i%
  18.        oFamilies = thiscomponent.StyleFamilies
  19.        sElements() = oFamilies.getElementNames()
  20.        sLabel = "Pick one style family or <All>"& chr(10) _
  21.              &"in order to remove all user defined (custom) styles"
  22.        oDlg = getListboxDialog("Remove Custom Styles", sLabel, sElements())
  23.        With oDlg.getControl("ListBox")
  24.           .addItem("<All>",0)
  25.           .selectItemPos(0,True)
  26.        End With
  27.        i = oDlg.execute()
  28.        sFamily = oDlg.getControl("ListBox").getSelectedItem
  29.        if i = 0 then
  30.           exit sub
  31.        endIf
  32.     'End Villeroy's code.
  33.     For c = 0 to uBound(oFamilies.ElementNames)
  34.     oStyleType = oFamilies.getByName(oFamilies.ElementNames(c))
  35.     If sFamily <> "<All>" and sFamily <> sElements(c) then goto SKIP
  36.     NamesArray = oStyleType.getElementNames
  37.     cnt = 0
  38.     For cc = 0 to uBound(NamesArray)
  39.       StyleName = NamesArray(cc)
  40.       ThisStyle = oStyleType.getByName(StyleName)
  41.       If ThisStyle.isUserDefined then
  42.        If sElements(c) = "NumberingStyles" and ThisStyle.isInUse _
  43.        and Not checked then
  44.          checked = True
  45.          Dim oDoc,NamesArray1,Used(),x,ts,n
  46.          oDoc = ThisComponent
  47.          NamesArray1 = oStyleType.getElementNames
  48.          For x = 0 to uBound(NamesArray1)  
  49.           ts = oStyleType.getByName(NamesArray1(x))
  50.           If ts.isUserDefined and ts.isInUse then
  51.            n = uBound(Used)+1
  52.            ReDim Preserve Used(n)
  53.            Used(n) = NamesArray1(x)
  54.           EndIf
  55.          Next x
  56.         IterateParagraphs(oDoc,Used(),NumberStyle)
  57.        EndIf
  58.        oStyleType.removeByName(StyleName)
  59.        cnt = cnt + 1
  60.       EndIf
  61.     Next cc
  62.     If ShowProgress then
  63.       a = "Deleted "& cnt &" custom style(s) of type " & sElements(c) & "."
  64.       MsgBox a
  65.     EndIf
  66.     SKIP:
  67.     Next c
  68.     If ShowDone then MsgBox "Done."
  69.     End Sub
  70.  
  71.     'Villeroy's code
  72.     REM get a auto-sized dialog with title, label, listbox, OK and Cancel
  73.     REM pass sFixedText with linebreaks Chr(10)
  74.     Function getListboxDialog(sTitle$,sFixedText$,aListItems())
  75.     Dim oDM,oDlg,oTools,oRegion,oRect,oPoint,oSz
  76.        oDM = CreateUnoService("com.sun.star.awt.UnoControlDialogModel")
  77.        oDM.Title = sTitle
  78.        REM addAwtModel dialogModel, c.s.s.awt.UnoControl<type>, name of control,
  79.        REM         (propertyNames), (propertyValues) !propertyNames in alpabetical order!
  80.        addAwtModel oDM,"FixedText","FixedText", _
  81.              Array("Label","MultiLine"), _
  82.              Array(sFixedText,True)
  83.        addAwtModel oDM,"ListBox","ListBox", _
  84.              Array("Dropdown","StringItemList"), _
  85.              Array(True,aListItems())
  86.        addAwtModel oDM,"Button","btnOK", _
  87.              Array("DefaultButton","Label","PushButtonType"), _
  88.              Array(True,"OK",com.sun.star.awt.PushButtonType.OK)
  89.        addAwtModel oDM,"Button","btnCancel", _
  90.              Array("Label","PushButtonType"), _
  91.              Array("Cancel",com.sun.star.awt.PushButtonType.CANCEL)
  92.        oDlg = CreateUnoService("com.sun.star.awt.UnoControlDialog")
  93.        oDlg.setModel(oDM)
  94.        oDlg.setVisible(True)
  95.        oTools = oDlg.getPeer.getToolkit
  96.        oRegion = oTools.createRegion
  97.        oPoint = createUnoStruct("com.sun.star.awt.Point")
  98.        oPoint.X = 5
  99.        oPoint.Y = 5
  100.        oRect = stackVertically(oDlg,Array("FixedText","ListBox","btnOK","btnCancel"),oRegion,oPoint,5)
  101.        oDlg.setPosSize(0,0, oRect.Width +oRect.X, oRect.Height +oRect.Y,com.sun.star.awt.PosSize.SIZE)
  102.        getListboxDialog = oDlg
  103.     End Function
  104.  
  105.     'Villery's code
  106.     Sub addAwtModel(oDM,srv,sName,aNames(),aValues())
  107.     Dim oCM
  108.        oCM = oDM.createInstance("com.sun.star.awt.UnoControl"+ srv +"Model")
  109.        oCM.setPropertyValues(aNames(),aValues())
  110.        oDM.insertByName(sName,oCM)
  111.     End Sub  
  112.  
  113.     'Villeroy's code
  114.     Function getControlSize(oCtrl)
  115.     '''Return preferred width and/or height, if not already set larger.'''
  116.     Dim curPS, prefSz
  117.        curPS = oCtrl.getPosSize()
  118.        prefSz = oCtrl.getPreferredSize()
  119.        if curPS.Width >= prefSz.Width  then prefSz.Width = curPS.Width
  120.        if curPS.Height >= prefSz.Height then prefSz.Height = curPS.Height
  121.     getControlSize = prefSz
  122.     End Function
  123.  
  124.     'Villeroy's code
  125.     Function stackVertically(oDlg,sNames(),oRegion,oPoint,optional spc)
  126.     'calls: getControlSize
  127.     '''Stack list of controls vertically, starting at point with optional spaces below.
  128.     'Calculate and set preferred width and/or height if not already set >= preferredSize.
  129.     'Out: resized oRegion with added rectangles.
  130.     'Returns new bounds of region'''
  131.     Dim y&, i%, s$, c, sz
  132.        if isMissing(spc) then spc = 0
  133.        y = oPoint.Y
  134.        for i = 0 to uBound(sNames())
  135.           s = sNames(i)
  136.           c = oDlg.getControl(s)
  137.           sz = getControlSize(c)
  138.           c.setPosSize(oPoint.X, y, sz.Width, sz.Height, com.sun.star.awt.PosSize.POSSIZE)
  139.           oRegion.unionRectangle(c.getPosSize())
  140.           y = y +sz.Height +spc
  141.        next
  142.     stackVertically = oRegion.getBounds()
  143.     End Function
  144.     'End Villery's code.
  145.  
  146.     Sub IterateParagraphs(oDoc,Used(),NumberStyle)
  147.     Dim enum,thisParagraph,c
  148.     enum = oDoc.Text.createEnumeration
  149.     While enum.hasMoreElements
  150.     thisParagraph = enum.nextElement
  151.     For c = 0 to uBound(Used)
  152.       If Not thisParagraph.SupportsService("com.sun.star.text.TextTable") then
  153.        If thisParagraph.NumberingStyleName = Used(c) then
  154.         thisParagraph.NumberingStyleName = NumberStyle
  155.        EndIf
  156.       EndIf
  157.     Next
  158.     Wend
  159.     End Sub
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top