1

Тема: Удаление стилей

Кто-то знает способ программного удаления стилей, которые не используются в документе?
Если не использовать On Error Resume Next, то выдаёт ошибку на некоторых стилях, которые как бы есть (в общем списке стилей отображается и у них есть свой порядковый номер), но и которых как бы и нет (удалить их невозможно -

Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871

2

Re: Удаление стилей

Fck_This пишет:

Кто-то знает способ программного удаления стилей, которые не используются в документе?Если не использовать On Error Resume Next, то выдаёт ошибку на некоторых стилях, которые как бы есть (в общем списке стилей отображается и у них есть свой порядковый номер), но и которых как бы и нет (удалить их невозможно -

Я удаляю такие стили макросом, который приведен ниже. Мне из него пришлось убрать строки дополнительной обработки, так что есть вероятность ошибки, но в целом понять можно.Состав действий такой:0. Если документ открыт на чтение, то обработка прекращается с выдачей сообщения об ошибке.1. Проверяется только документ, к которому прикреплен стилевой шаблон, если шаблона нет или он по месту не найден, то обработка прекращается с выдачей сообщения об ошибке.2. Проверяются имена стилей в документе. Если стиль имеет в имени символ разделителя (напр.,

3

Re: Удаление стилей

Fck_This пишет:

Кто-то знает способ программного удаления стилей, которые не используются в документе?
Если не использовать On Error Resume Next, то выдаёт ошибку на некоторых стилях, которые как бы есть (в общем списке стилей отображается и у них есть свой порядковый номер), но и которых как бы и нет (удалить их невозможно -

ОПЯТЬ ТЕКСТ ОБРЕЗАЛСЯ
Я удаляю такие стили макросом, который приведен ниже. Мне из него пришлось убрать строки дополнительной обработки, так что есть вероятность ошибки, но в целом понять можно.
Состав действий такой:
0. Если документ открыт на чтение, то обработка прекращается с выдачей сообщения об ошибке.
1. Проверяется только документ, к которому прикреплен стилевой шаблон, если шаблона нет или он по месту не найден, то обработка прекращается с выдачей сообщения об ошибке.
2. Проверяются имена стилей в документе. Если стиль имеет в имени символ разделителя (напр., ";"), то он переименовывается в имя, равное подстроке до разделителя.
3. Составляется список легальных стилей в документе. Если стиль не встроенный (в Word), не найден в стилевом шаблоне и не используется в документе, то стиль нелегален.
4. Нелегальные стили удаляются по списку.

Sub LeaveLegalStyles()
'Leaves only legal styles in doc
Dim ist As Long
Dim stn As String
Dim stnewas As String
Dim nsav As Long
Dim scpos As Long
Dim nren As Long
Dim ndel As Long
Dim bf As Boolean
Dim stt As Style
Dim usedtemplate As String
Dim ad As Document
Dim ast As Document
Dim nst As Long
Dim delstyles() As String
Dim idels As Long
Dim ndels As Long

Dim view_all, view_field_codes, view_mode
Dim opt_repag_mode As Boolean
Dim alerts_mode As Boolean
Dim scrupd_mode As Boolean
Dim okRun As Boolean

'Show all characters and field codes
view_all = ActiveWindow.ActivePane.View.ShowAll
view_field_codes = ActiveWindow.View.ShowFieldCodes
view_mode = ActiveWindow.View.Type
opt_repag_mode = Application.Options.Pagination
alerts_mode = Application.DisplayAlerts
scrupd_mode = Application.screenupdating

Application.screenupdating = False
Application.DisplayAlerts = False
ActiveWindow.ActivePane.View.ShowAll = True
ActiveWindow.View.ShowFieldCodes = True
ActiveWindow.View.Type = wdNormalView
Application.Options.Pagination = False

nren = 0
ndel = 0
nsav = 0
okRun = True

'.0 Is the docread-only?
If ActiveDocument.ReadOnly Then
    MsgBox "Error: the document is in read-only state which prevents managing document's styles"
    okRun = False
    GoTo e_LLS
End If

'1. Check style template
Set ad = ActiveDocument
Set ast = ActiveDocument.AttachedTemplate.OpenAsDocument
ad.Activate
usedtemplate = Application.Dialogs(wdDialogToolsTemplates).template
If Not File_Exists(usedtemplate) Then
    MsgBox "The used template associated to the document is " & vbCrLf & _
    usedtemplate & vbCrLf & _
    "This file is not found by this path in the current computer." & vbCrLf & _
    "The style check is canceled."
    okRun = False
    GoTo e_LLS
End If

'2. Rename styles having ";" in their names
nsav = 0
nst = ad.Styles.Count

For ist = 1 To nst
    Set st = ad.Styles(ist)
    stn = st.NameLocal
    scpos = InStr(stn, ";") 'this separating character may depend on Windows Local Settings
    If scpos > 1 Then
        stnew = GetHead(stn, ";")
        On Error Resume Next
        st.NameLocal = stnew
        nren = nren + 1
        nsav = 0
        ActiveDocument.AttachedTemplate.Saved = True
        ActiveDocument.Save
        On Error GoTo 0
    End If
    Set st = Nothing
Next ist

'3. Search for illegal styles ( a) non-builtin; b) not used in the doc; c) not found in the style template)
idels = 0
ndels = 0
Selection.GoTo What:=wdGoToLine, Which:=wdGoToFirst

For ist = 1 To nst
    Set st = ad.Styles(ist)
    stn = st.NameLocal
    If Not (stn = "") Then
        If (Not st.BuiltIn) Then
            bf = FindStyle(stn) 'search something in this style inthe document
            If Not bf Then
                Set stt = Nothing
                On Error Resume Next
                Set stt = ast.Styles(stn)
                On Error GoTo 0
                If (stt Is Nothing) Then
                    On Error Resume Next
                    idels = idels + 1
                    ReDim Preserve delstyles(1 To idels)
                    delstyles(idels) = stn
                End If
            Else
                Selection.GoTo What:=wdGoToLine, Which:=wdGoToFirst
            End If
        End If
    End If
    Set st = Nothing
Next ist
ndels = idels

'Deleting illegal styles
If ndels > 0 Then
    nsav = 0
    For idels = 1 To ndels
        Set st = ad.Styles(delstyles(idels))
            On Error Resume Next
            'st.Delete
            ActiveDocument.Styles(delstyles(idels)).Delete
            On Error GoTo 0
            nsav = nsav + 1
            If nsav > 10 Then
                ActiveDocument.AttachedTemplate.Saved = True
                nsav = 0
                ActiveDocument.Save
                ActiveDocument.UndoClear
            End If

        Set st = Nothing
    Next idels
End If

e_LLS:
On Error Resume Next
ast.Close savechanges:=wdDoNotSaveChanges
Set ast = Nothing
ad.Activate
Set ad = Nothing

If okRun Then
    MsgBox "Renamed: " & CStr(nren) & " styles;" & vbCrLf & "Deleted: " & CStr(ndels) & " styles."
End If

End Sub

4

Re: Удаление стилей

yshindin пишет:

. . .
Состав действий такой:
0. Если документ открыт на чтение, то обработка прекращается с выдачей сообщения об ошибке.
1. Проверяется только документ, к которому прикреплен стилевой шаблон, если шаблона нет или он по месту не найден, то обработка прекращается с выдачей сообщения об ошибке.
2. Проверяются имена стилей в документе. Если стиль имеет в имени символ разделителя (напр., ";"), то он переименовывается в имя, равное подстроке до разделителя.
3. Составляется список легальных стилей в документе. Если стиль не встроенный (в Word), не найден в стилевом шаблоне и не используется в документе, то стиль нелегален.
4. Нелегальные стили удаляются по списку.

В коде макроса есть вызовы подпрограмм, которыми я часто пользуюсь, напр., GetHead или FindStyle. Их назначение понятно из названия, вот их код:

Function FindStyle(stn As String) As Boolean
    If stn <> "" Then
        On Error Resume Next
        Selection.GoTo What:=wdGoToLine, Which:=wdGoToFirst
        Selection.Find.ClearFormatting
        Selection.Find.Style = ActiveDocument.Styles(stn)
        Selection.Find.replacement.ClearFormatting
        With Selection.Find
            .text = ""
            .replacement.text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = True
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute
        FindStyle = Selection.Find.found
        On Error GoTo 0
    Else
        MsgBox "Style " & stn & " not found"
    End If
End Function

Public Function GetHead(ByVal input_line As String, ByVal sep_line As String) As String
'get substring from the beginning of the input_line till
'the char, preceding the sep_line
Dim i_sep As Integer
Dim output_line As String

i_sep = InStr(input_line, sep_line)
If i_sep > 0 Then
   output_line = Mid$(input_line, 1, i_sep - 1)
Else
   output_line = ""
End If
GetHead = output_line
End Function

5

Re: Удаление стилей

Спасибо, будем пробовать. Хотя сходу попытка переименовать стиль ничего не дала. Он так и остался с тем же именем. Возможно это как-то связано с тем, что он основан на стиле "(свойства)". Изменить данный параметр невозможно, пишет, что уже зарезервировано такое имя для втроенного стиля. Т.е. если он основан на встроенном, то, как и сам встроенный, хрен поменяешь. Хотя код переименования проходит без ошибок

Вообще такие функции, вроде возвращающей строку до знака, удобны в долгосрочном плане - на многих проектах, но для одного заменять одну строку
If InStr(oStyle, ";") >= 1 Then  oStyle.NameLocal = Left(оСтиль, InStr(оСтиль, ";") - 1)
функцией по мне - ну такое. Так можно каждую функцию уже готовую наделать пользовательских function и запутаться в них. Типо, сделаю ка я функцию сохранения дока Сall DocSaver(oDoc.name) Sub DocSaver(ByRef oDoc as Document) oDoc.save. А если придётся переписать код - будешь прыгать по ним в поисках smile

Спасибо можно перевести на WebMoney-кошелёк R378231864568 или на Яндекс-деньги 410015093172871