Remove unused custom styles

Creating Extension - Shared Libraries
Forum rules
For sharing working examples of macros / scripts. These can be in any script language supported by OpenOffice.org [Basic, Python, Netbean] or as source code files in Java or C# even - but requires the actual source code listing. This forum is not for asking questions about writing your own macros.

Remove unused custom styles

Postby Hagar Delest » Sun Jul 17, 2011 12:24 am

When you copy and paste data from an application to a document in OOo, styles are often imported. When you remove the formatting or apply a custom one afterward, you get a bunch of unused styles in the Navigator.

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   Expand viewCollapse view
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
AOO 4.0.1 on Windows 7 and Xubuntu 14.04 (Trusty Tahr)
User avatar
Hagar Delest
Moderator
 
Posts: 25106
Joined: Sun Oct 07, 2007 9:07 pm
Location: France

Re: Remove unused custom styles

Postby Hagar Delest » Tue Jul 19, 2011 1:22 pm

Here is an even more tweaked version:
- by default all the styles are handled (no dialog for asking)
- no message displayed when nothing to delete.
Note that keeping the display of styles to be removed lets you check that there is no custom style that you don't want to delete (if not yet used); it can be the case in not so old documents where you haven't applied all your custom styles.

Code: Select all   Expand viewCollapse view
sub MainRemoveUnusedStyles()
'calls: RemoveUnusedStyles
Dim sElements() as string, oFamilies, oFamily, sFamily$, sLabel, oDlg, i%
oFamilies = thiscomponent.StyleFamilies
sElements() = oFamilies.getElementNames()
For i = 0 to uBound(sElements())
   oFamily = oFamilies.getByName(sElements(i))
   RemoveUnusedStyles(oFamily,sElements(i),True)
Next
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)
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
EndIf
End Sub

'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
AOO 4.0.1 on Windows 7 and Xubuntu 14.04 (Trusty Tahr)
User avatar
Hagar Delest
Moderator
 
Posts: 25106
Joined: Sun Oct 07, 2007 9:07 pm
Location: France

Re: Remove unused custom styles

Postby Nikos » Wed Jun 20, 2012 9:51 am

I know this is an old topic, but still works on LibO 3.5.4. So I just wanted to say thank you...you saved me at least half an hour of completely stupifying work.

:bravo:
LibreOffice 4.0.5 on OpenSuse 12.3/64bit/KDE4.10 (Version from the TDF page) + LibreOffice 4.1.1 on Debian Wheezy/64bit/KDE4.8 + LibreOffice 4.1.1 on Win7/64bit
Nikos
 
Posts: 172
Joined: Mon Dec 17, 2007 11:50 am

Re: Remove unused custom styles

Postby Hagar Delest » Sat Jul 14, 2012 9:19 pm

Another version where you can add the custom styles that may not be in use when you run the macro but that you want to keep for future use:
Code: Select all   Expand viewCollapse view
sub MainRemoveUnusedStyles()
'calls: RemoveUnusedStyles
Dim sElements() as string, oFamilies, oFamily, sFamily$, sLabel, oDlg, i%
Dim oDoc as object
oDoc = ThisComponent
oFamilies = thiscomponent.StyleFamilies
sElements() = oFamilies.getElementNames()
For i = 0 to uBound(sElements())
   oFamily = oFamilies.getByName(sElements(i))
   RemoveUnusedStyles(oFamily,sElements(i),True)
Next
Nettoyage_mail
If HasUnoInterfaces(oDoc, "com.sun.star.util.XCloseable") Then
  oDoc.close(true)
Else
  oDoc.dispose()
End If
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)
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
EndIf
End Sub

'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 sName = "MyStyle1" or sName = "MyStyle2" or sName = "MyStyle3" or sName = "MyStyle4" or sName = "MyStyle5" then
      chkUse = False
   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

The trick is to add a condition that reverts the switch for unused styles to false if the style matches the ones you want to keep. It has to be set just before the final test is done to decide for the deletion:
Code: Select all   Expand viewCollapse view
   ...
   If sName = "MyStyle1" or sName = "MyStyle2" or sName = "MyStyle3" or sName = "MyStyle4" or sName = "MyStyle5" then
      chkUse = False
   Endif
   If chkUse AND chkUDef then
   ...

You just have to set manually the style names (MyStyleX above) before running the macro.
AOO 4.0.1 on Windows 7 and Xubuntu 14.04 (Trusty Tahr)
User avatar
Hagar Delest
Moderator
 
Posts: 25106
Joined: Sun Oct 07, 2007 9:07 pm
Location: France


Return to Code Snippets

Who is online

Users browsing this forum: No registered users and 2 guests