"Макросы MS-Word для обработки текстов" - читать интересную книгу автора

Макросы MS-Word для обработки текстов

Сохранить doc-файл в txt, выделив стили html-тагами
From: Максим Мошков
Sub MAIN
EditFindFont .Points = "", .Underline = - 1, .Color = - 1, .Strikethrough = - 1, .Superscript = - 1, .Subscript = - 1, .Hidden = - 1, .SmallCaps = - 1, .AllCaps = - 1, .Spacing = "", .Position = "", .Kerning = - 1, .KerningMin = "", .Tab = "0", .Font = "(
EditReplace .Find = "", .Replace = "i>^/i>", .Direction = 0, .MatchCase = 0, .WholeWord = 0, .PatternMatch = 0, .SoundsLike = 0, .ReplaceAll, .Format = 1, .Wrap = 1
EditFindFont .Points = "", .Underline = - 1, .Color = - 1, .Strikethrough = - 1, .Superscript = - 1, .Subscript = - 1, .Hidden = - 1, .SmallCaps = - 1, .AllCaps = - 1, .Spacing = "", .Position = "", .Kerning = - 1, .KerningMin = "", .Tab = "0", .Font = "(
EditReplace .Find = "", .Replace = "b>^/b>", .Direction = 0, .MatchCase = 0, .WholeWord = 0, .PatternMatch = 0, .SoundsLike = 0, .ReplaceAll, .Format = 1, .Wrap = 1
EditFindFont .Points = "", .Underline = 1, .Color = - 1, .Strikethrough = - 1, .Superscript = - 1, .Subscript = - 1, .Hidden = - 1, .SmallCaps = - 1, .AllCaps = - 1, .Spacing = "", .Position = "", .Kerning = - 1, .KerningMin = "", .Tab = "0", .Font = "(no
EditReplace .Find = "", .Replace = "u>^/u>", .Direction = 0, .MatchCase = 0, .WholeWord = 0, .PatternMatch = 0, .SoundsLike = 0, .ReplaceAll, .Format = 1, .Wrap = 1
EditFindFont .Points = "", .Underline = - 1, .Color = - 1, .Strikethrough = - 1, .Superscript = 1, .Subscript = 0, .Hidden = - 1, .SmallCaps = - 1, .AllCaps = - 1, .Spacing = "", .Position = "", .Kerning = - 1, .KerningMin = "", .Tab = "0", .Font = "(norm
EditReplace .Find = "", .Replace = "sup>[^/sup>", .Direction = 0, .MatchCase = 0, .WholeWord = 0, .PatternMatch = 0, .SoundsLike = 0, .ReplaceAll, .Format = 1, .Wrap = 1
ChDefaultDir "E:\", 0
FileSaveAs .Name = "MOSHKOW.TXT", .Format = 2, .LockAnnot = 0, .Password = "", .AddToMru = 1, .WritePassword = "", .RecommendReadOnly = 0, .EmbedFonts = 0, .NativePictureFormat = 0, .FormsData = 0
End Sub

Убирание лишних переводов строк и пробелов в абзацев
From: [email protected]
Sub Probel()
Dim i As Long
For i = 1 To 100 'Как узнать число символов в тексте :(
'Сервис => Статистика => Число символов
nex:
Selection.Move
If (Selection.Text = " ") Then
Selection.Move Unit:=wdCharacter, Count:=-1
If (Selection.Text = " ") Then
Selection.Delete Unit:=wdCharacter, Count:=1
Else
Selection.Move
i = i + 1
End If
End If
If (Selection.Text = Chr$(13)) Then
Selection.Move Unit:=wdCharacter, Count:=1
i = i + 1
If (Selection.Text = Chr$(13)) Then
Selection.Move Unit:=wdCharacter, Count:=1
i = i + 1
GoTo nex
End If
If (Selection.Text = "@") Then
Selection.Move Unit:=wdCharacter, Count:=-1
i = i - 1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
i = i + 3
GoTo nex