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