Регистрация Вход
Библиотека /
Поиск по библиотекеМоя библиотекаИскать книгу(обмен)

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

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


Макрос для Word 97


Сохранить doc-файл в txt, выделив стили html-тагами


From: Максим Мошков Sub Libru() ' ' Libru Макрос ' Макрос записан 04.12.00 moshkow@ipsun.ras.ru ' Selection.Find.ClearFormatting Selection.Find.Font.Bold = True 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 Replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Font.Italic = True 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 Replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Font.Underline = wdUnderlineSingle 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 Replace:=wdReplaceAll Selection.Find.ClearFormatting With Selection.Find.Font .Underline = wdUnderlineNone .StrikeThrough = False .DoubleStrikeThrough = False .Superscript = True .Subscript = False End With 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 Replace:=wdReplaceAll ChangeFileOpenDirectory "C:\WINDOWS\TEMP\" ActiveDocument.SaveAs FileName:="C:\BBS\moshkow.txt", FileFormat:= _ wdFormatText, LockComments:=False, Password:="", AddToRecentFiles:=True, _ WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _ SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _ False ActiveDocument.Close End Sub

Макрос для Word-6


Сохранить 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 = "(normal text)", .Bold = - 1, .Italic = 1 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 = "(normal text)", .Bold = 1, .Italic = - 1 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 = "(normal text)", .Bold = - 1, .Italic = - 1 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 = "(normal text)", .Bold = - 1, .Italic = - 1 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: Aquary@mail.ru 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 End If If (Selection.Text <> " ") Then Selection.Move Unit:=wdCharacter, Count:=-1 i = i - 1 Selection.Delete Unit:=wdCharacter, Count:=1 Selection.InsertAfter (" ") Else Selection.Move Unit:=wdCharacter, Count:=2 i = i + 2 If (Selection.Text <> " ") Then Selection.Move Unit:=wdCharacter, Count:=1 i = i + 1 End If End If End If Next End Sub

Наша библиотека является официальным зеркалом библиотеки Максима Мошкова lib.ru

Реклама