Есть документ (см.вложение), в нем нет никакого текста, макрос ShowStyles выдает 266 стилей
Sub ShowStyles()
Dim i As Integer
MsgBox "Количество стилей: " & ActiveDocument.Styles.Count
Selection.EndKey Unit:=wdStory
For i = 1 To ActiveDocument.Styles.Count
'вывод номеров стилей и их наименований в конец текущего файла
Selection.Range.Text = i & " " & ActiveDocument.Styles(i).NameLocal
Selection.EndKey Unit:=wdLine
Selection.TypeParagraph
Next i
End Sub
Вот этим макросом пробую удалять неспользованные стили
Sub DeleteUnusedStyles()
Dim oSt As Style, sMsg As String, oStrRange As Range
For Each oSt In ActiveDocument.Styles
On Error Resume Next
If Not oSt.BuiltIn Then 'Если стиль не встроенный
For Each oStrRange In ActiveDocument.StoryRanges
With oStrRange.Find
.Style = oSt.NameLocal 'Ищем все вхождения текста, оформленного заданным стилем
.Execute
If (Not .Found) And Err.Number = 0 Then 'Если не нашли такой текст, и нет ошибок, то стиль удаляем
sMsg = sMsg & "Удален """ & oSt.NameLocal & """" & vbCr: oSt.Delete
ElseIf CBool(Err.Number) Then 'Если есть ошибка, то сообщаем об этом
sMsg = sMsg & "Невозможно удалить """ & oSt.NameLocal & """" & ". Причина: " & Err.Description & vbCr
Err.Clear
End If
End With
Next oStrRange
End If
Next
MsgBox sMsg, vbInformation, "Результаты удаления стилей"
End Sub
Никаках стилей не удалил, осталоись все те же. Пробовал другим макросом
Sub Удалить_стили()
Debug.Print "<<< Старт " & Now
Dim myStyle As Word.Style
Dim i&, N1&, N2&
Dim S$
N1 = 0: N2 = 0
For i = ActiveDocument.Styles.Count To 1 Step -1
Set myStyle = ActiveDocument.Styles(i)
If myStyle.BuiltIn = True Then
ElseIf myStyle.InUse <> True Then
Else
S = myStyle.NameLocal
With ActiveDocument.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
.Format = True
.Style = S
.Execute Replace:=Word.wdReplaceNone
If .Found = True Then
Else
On Error Resume Next
myStyle.Delete
If Err.Number <> 0 Then
N2 = N2 + 1
Debug.Print _
"- Ошибка " & CStr(Err.Number) & " (" & Err.Description & ")" & _
" при удалении стиля """ & S & """"
End If
If IsObjectValid(myStyle) Then
Debug.Print "- Не был удален стиль """ & S & """"
Else
N1 = N1 + 1
Debug.Print "+ Удален стиль """ & S & """"
End If
End If
End With
End If
Next i
Debug.Print "= Удалено: " & CStr(N1)
Debug.Print "= Ошибок: " & CStr(N2)
Debug.Print ">>> Финиш " & Now
End Sub
то же ничего не удалил.
через "Организатор" удаление не устраивает, т.к. там остаются только встроенные стили, а надо чтобы в документе оставались еще и использованные стили.
Post's attachmentsОпытный файл.docx 57.13 Кб, 5 скачиваний с 2012-08-23
You don't have the permssions to download the attachments of this post.