Макрос для удаления всех пользовательских стилей в документе

[Димычч]

Добрый день.
Тема уже поднималась, но не была решена. Прошу помочь создать инструмент для её, хотя бы частичного, решения.
Напомню, чем опасно большое количество стилей в документе:
1. Увеличение объёма файла.
2. Увеличение времени открытия/пересчёта ячеек/сохранения файла.
3. Поскольку о достижении предельного значения стилей в документе (около 65000) эксель никак не сообщает, это может выражаться, например, во внезапном отказе добавлять новые листы, изменять форматы. Также, это может служить причиной вывода сообщения "Слишком много различных форматов ячеек" со всеми вытекающими.
Прошу не путать "Стили" и "Форматы". Документ может быть переполнен стилями и быть неработоспособным, при этом, в нём может быть единственный пустой лист с очищенными форматами. Заразить свой файл этой заразой можно всего лишь скопировав пустой лист из заражённого файла.
Удаление styles.xml - не решение, так как оно удаляет и все видимые форматы в книге.
Имеется макрос, удаляющий бОльшую часть ненужных ситилей:

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

Sub Del_Styles()
Dim stl As Style
On Error Resume Next
For Each stl In ActiveWorkbook.Styles
If Not stl.BuiltIn Then stl.Delete
Next
End Sub
Прошу помочь расширить его функционал, а именно: перед его запуском выводить запрос "Обнаружено ** стилей. Удалить? да/нет". И после окончания работы также выводить сообщение "Удалено ** стилей. ** осталось". Хочется и Progress-bar с % выполнения, но, думаю, это слишком сложно
Первый запрос нужен чтобы просто понять, есть ли необходимость вообще запускать этот макрос, так как он работает иногда по 30-40 мин.
Сведения о количестве стилей содержатся в styles.xml в разделах "cellStyleXfs count" и "cellXfs count".

[cheshiki1]

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

Sub Del_Styles()
Dim stl As Style, S, col&, Scol&
On Error Resume Next
Scol = ActiveWorkbook.Styles.Count
S = MsgBox("Обнаружено " & Scol & " стилей. УДАЛИТЬ?", vbYesNo)
If S = vbYes Then
  For Each stl In ActiveWorkbook.Styles
  If Not stl.BuiltIn Then
  stl.Delete
  col = col + 1
  End If
  Next
End If
MsgBox "Удалено " & col & " стилей. " & Scol - col & " осталось."
End Sub

Progress-bar пока не приходилось делать так что моих знаний здесь возможно маловато для его создания.

[Димычч]

Здорово! Всё работает!
Маленький нюанс: если в первом окне ответить НЕТ, то открывается второе, с нулевым результатом удаления. Логичнее было бы ничего не отображать после нажатия на НЕТ.
Интересное наблюдение: имеется файлик 800Кб, у него только одна табличка 20х8 на единственном листе. Запускаем макрос, видим "обнаружено 44000 стилей", макрос работает 19 минут над этим малышом, остаток - 45 стилей. Запускаю его повторно, вижу уже 316, чищу, вижу 45, и т.д. То есть остаются какие то неудаляемые. (вложение 3вв)

[cheshiki1]

Логичнее было бы ничего не отображать после нажатия на НЕТ.

перенесите последнее msgbox перед последим end if
47 заводских стиля у меня - они будут всегда оставаться.
про остальные ничего не скажу, знаний маловато.

[Димычч]

Спасибо, всё работает в лучшем виде!