Delete custom styles
Posted: 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
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