There is already a macro to remove the custom styles: Delete custom styles but if you have custom styles of your own that have to be kept, you can't use it.
So here is a version slightly modified from that macro: Delete unused custom paragraph styles. I've tweaked Villeroy's macro because it can handle styles for Writer, Calc, Impress and Draw. Display of styles to be deleted has been improved and message when nothing to be used too.
To install, just select the whole code and paste it in a new module. See also: Tutorial: How to install a code snippet.
Code: Select all
REM Option Explicit
sub MainRemoveUnusedStyles()
'calls: getListBoxDialog, RemoveUnusedStyles
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 unused userdefined styles"
oDlg = getListboxDialog("Remove Unused 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
elseif sFamily = "<All>" then
for i = 0 to uBound(sElements())
oFamily = oFamilies.getByName(sElements(i))
RemoveUnusedStyles(oFamily,sElements(i),True)
next
else
oFamily = thisComponent.StyleFamilies.getByName(sFamily)
RemoveUnusedStyles(oFamily,sFamily,True)
endif
End Sub
Sub RemoveUnusedStyles(oFamily,sFamily as string, bAsk as Boolean)
'calls: getStyleNames
Dim sUsed() as String, sMsg$,iAnswer%, bStop as boolean
sUsed() = getStyleNames(oFamily,bLocalized:=False,bUsed:=False,bUserDef:=true)
'print join(sused(),"; ")
if uBound(sUsed()) > -1 then
bStop = false
For i = 1 To UBound(sUsed())+1
sMsg = sMsg + i + " : " + sUsed(i-1) + CHR$(10)
If ((i) Mod 30 = 0) Then
iAnswer = MsgBox("Remove following " + sFamily + CHR$(10) + sMsg,33,"Remove Unused Styles")
sMsg = ""
If iAnswer <>1 then
bStop = true
exit For
End If
EndIf
Next i
If not bStop then
iAnswer = MsgBox("Remove following " + sFamily + CHR$(10) + sMsg,33,"Remove Unused Styles")
If iAnswer = 1 then
for i= 0 to uBound(sUsed())
oFamily.removeByName(sUsed(i))
Next
EndIf
EndIf
else
msgbox "No unused " & sFamily & " to remove.",48, "Remove Unused Styles"
endif
End Sub
REM ***** BASIC *****
REM Option Explicit
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
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
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
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
'calls: bas_PushArray
'returns: a string-array of style-names
'oFamily:= a style family, derived from a doc (writer,calc,draw,impress)
'bLocalized:= return localized names of the builtin styles (eg. builtin "Default" --> german "Standard")
'bUsed:= only used styles. true/false for used/unused, missing for all
'bUserDef:= only builtin styles. true/false for userDefined/Builtin, missing for all
Function getStyleNames(oFamily,bLocalized as Boolean, _
optional bUsed, optional bUserDef)
Dim oStyle,i%,sNames$(),sName$,chkUse as Boolean, chkUDef as Boolean
for i = 0 to oFamily.getCount -1
oStyle = oFamily.getByIndex(i)
if bLocalized then
sName = oStyle.DisplayName
else
sName = oStyle.getName
endif
if (vartype(bUsed) = 11)then
chkUse = (bUsed EQV oStyle.isInUse)
else
chkUse = True
endif
if (vartype(bUserDef) = 11) then
chkUDef = (bUserDef EQV oStyle.isUserDefined)
else
chkUDef = True
endif
If chkUse AND chkUDef then
bas_Pusharray sNames(),sName
endif
next
getStyleNames = sNames()
End Function
'very simple routine appending some element to an array which can be undimensioned (LBound > UBound)
Sub bas_PushArray(xArray(),vNextElement)
Dim iUB%,iLB%
iLB = lBound(xArray())
iUB = uBound(xArray())
If iLB > iUB then
iUB = iLB
redim xArray(iLB To iUB)
else
iUB = iUB +1
redim preserve xArray(iLB To iUB)
endif
xArray(iUB) = vNextElement
End Sub 