Удалить все неиспользуемые стили из электронной таблицы Calc

[kompilainenn]

Есть документ XLSX (он рабочий, выложить не могу) с более чем 1000 стилей, которые явно не используются в документе. Как их поудалять за один раз и быстро? Макрос, который советуют на планетеэксель, очень долго работает в тот самом Эксель:

Код Выделить Развернуть

Sub Reset_Styles()
    'удаляем все лишние стили
    For Each objStyle In ActiveWorkbook.Styles
        On Error Resume Next
        If Not objStyle.BuiltIn Then objStyle.Delete
        On Error GoTo 0
    Next objStyle
    'копируем стандартный набор стилей из новой книги
    Set wbMy = ActiveWorkbook
    Set wbNew = Workbooks.Add
    wbMy.Styles.Merge wbNew
    wbNew.Close savechanges:=False
End Sub

[sokol92]

Добрый день! Можно попробовать выделить все листы (есть в меню по правой кнопке по ярлыку листа) и (в том же меню) скопировать в новую книгу. При этом неиспользуемые стили, как правило, не копируются. Если эта операция производится регулярно и указанный способ помогает, но можно написать макрос для Excel или Calc.

[economist]

Мне попадался от hh тандера файлик с 11 тыс. стилей(!), тупил он безбожно.
Проблемы достигают такого уровня, что вместо чисел выводятся даты итп. Т.е. заболевает стиль ОБЩИЙ. Решение - загрузить чистые стили по умолчанию из другой пустой книги:
Создаем чистую книгу Excel с дефолтными стилями и делаем её ReadOnly. В больном файле запускаем макрос.

Код Выделить Развернуть


Sub MergeMyStyles()
' импортирует стили ячеек в эту книгу
    ans = MsgBox("Внимание! Если у Вас вместо чисел в ячейках вводятся даты - можно вылечить стиль ОБЩИЙ! Вылечить? ", vbYesNo + vbQuestion)
    If ans = 6 Then
    Dim StylesWb As Workbook
    Set StylesWb = GetObject("M:\BACKUP\!СтилиТолькоЧтение.xlsx")
    Application.DisplayAlerts = False
        ActiveWorkbook.Styles.Merge StylesWb
        StylesWb.Close
    Application.DisplayAlerts = True
    End If
   
    ans = MsgBox("Лечение формата завершено. Новые листы будут здоровыми. В старых листах - проверьте формат - Общий (или Стиль - Обычный)", vbYesNo + vbQuestion)
End Sub


[Wapr Old]

При этом неиспользуемые стили, как правило, не копируются.

А как быть, если есть стили, которыми ни одна ячейка не отформатирована, но при этом они родительские для других, используемых стилей? Если их удалить, рушится ВСЁ!

[sokol92]

рушится ВСЁ

Приведите, пожалуйста, пример, когда при копировании листов используемый дочерний стиль копируется, а неиспользуемый родительский - нет.
Во вложении к ячейке A1 применен стиль MyChild, дочерний по отношению к MyParent, который непосредственно не используется. При копировании листа стиль MyParent копируется.

[eeigor]

Создайте новый самостоятельный стиль с нужными установками. Выделите целевые ячейки и щёлкните два раза по имении созданного стиля.
В чём проблема? Сложно выделить диапазоны ячеек? Или много данных, разбросанных беспорядочно там и сям?.. Теперь можно удалить неиспользуемые стили.

[kompilainenn]

Или много данных, разбросанных беспорядочно там и сям?

Да. Вообще я нашёл выход и в ЛО, можно выбрать неиспользуемые стили через Шифт и все их поудалять. Однако выявилась проблема другого характера, при сохранении этого файла в ЛО и последующем его открытии в МСО - МСО файл не открывает. Это проблема не стилей, однако получается, что на данный момент работать с этим файлом в ЛО нельзя и надо мучать макрос в эксель

[sokol92]

В Excel можно начать со следующей базовой конструкции (VBA):

Код Выделить Развернуть

Option Explicit

' Копирует в новую книгу все листы активной книги.
' Если VisibleOnly=True (умолчание), то копируются только видимые листы.
Sub CopySheets(Optional ByVal VisibleOnly As Boolean = True)
  Dim sh As Worksheet, arr(), i As Long
  ReDim arr(Worksheets.Count - 1)
  i = -1
  For Each sh In ActiveWorkbook.Worksheets
    If sh.Visible = xlSheetVisible Or Not VisibleOnly Then
      i = i + 1
      arr(i) = sh.Name
    End If
  Next sh
  If i >= 0 Then
    If i < UBound(arr) Then ReDim Preserve arr(i)
    Worksheets(arr).Copy
  End If
End Sub

[Wapr Old]

Приведите, пожалуйста, пример, когда при копировании листов используемый дочерний стиль копируется, а неиспользуемый родительский - нет.

Я извиняюсь. За полтора года забыл точные условия ошибки.  
Необходимо применять стили не непосредственно, а через условное форматирование.
LO 7.0.5.2 x64 Win

[sokol92]

Да, Вы правы, спасибо за пример. Условному форматированию на багзилле уже посвящено свыше 200 незакрытых сообщений.

[luu]

Пользователи постоянно копируют ячейки из Excel, в результате чего создается куча "левых" стилей, число их тысячи со временем. Файл становится неповоротливым, удалять эти стили вручную с каждым разом все сложнее.

Можно ли написать макрос на Basic, позволяющий удалить все стили, а в идеале удалить все стили, кроме определенных заданных поимённо?

[luu]

Сам спросил, сам отвечаю:

Код Выделить Развернуть

Sub RemoveStylesExceptSpecified()
    Dim oStyleFamilies As Variant
    Dim oCellStyles As Variant
    Dim oStyle As Variant
    Dim i As Long
    Dim sKeepList As String
    Dim aKeep() As String
    Dim sName As String
   
    ' Список стилей для сохранения (разделитель - запятая)
    sKeepList = "Основной,Заголовок таблицы,Итоги" ' Замените на свои стили
    aKeep = Split(sKeepList, ",")
   
    ' Очистка и нормализация списка исключений
    For i = 0 To UBound(aKeep)
        aKeep(i) = Trim(aKeep(i))
        aKeep(i) = LCase(aKeep(i)) ' для регистронезависимого сравнения
    Next i
   
    On Error Resume Next ' Игнорировать ошибки при удалении
   
    oStyleFamilies = ThisComponent.StyleFamilies
    oCellStyles = oStyleFamilies.getByName("CellStyles")
   
    For i = oCellStyles.getCount() - 1 To 0 Step -1
        oStyle = oCellStyles.getByIndex(i)
        sName = oStyle.Name
       
        ' Проверяем, нужно ли сохранить стиль
        If Not IsInArray(LCase(sName), aKeep) And oStyle.isUserDefined() Then
            oCellStyles.removeByName(sName)
        End If
    Next i
   
    MsgBox "Удаление завершено! Сохранены стили: " & sKeepList, 64, "Готово"
End Sub

' Вспомогательная функция для регистронезависимой проверки
Function IsInArray(sVal As String, aArr As Variant) As Boolean
    Dim v As Variant
    IsInArray = False
    For Each v In aArr
        If sVal = v Then
            IsInArray = True
            Exit Function
        End If
    Next
End Function