Известно, что Microsoft Word любых версий порождает сильно избыточный и "тяжёлый" HTML-код. Данная утилита - одно из возможных решений для "чистки" такого кода. Чуть ниже - простое решение на VBA.

Открыв файл командой File.Open, назначьте путь для сохранения файла со сжатым HTML и нажмите ZIP:

По умолчанию утилита не трогает дополнительные теги офиса для форм и автофигур (Shapes), так как без них не будет конвертированных из Word рисунков.

Чистится не всё подряд, а только то, что разрешено в настройках (Help-Option). При этом можно гибко указать настройки для каждого тега и каждого атрибута:

При настройке приложения, сохранённой в файле tmp.ini архива (она минимально отличается от настройки по умолчанию) размер тестового файла WordHTML уменьшился с 2124 до 830 Кб. При этом файл содержал схемы Word, которые не обрабатывались.

Вот информация из окна "О программе":

WordHTMLZipper
Application for hypertext - files zipping.
local: En (software)
Project author: Pers (pers@mail.ru)
Coding: Ershov D.I. (d_ershov@ngs.ru)

Приложение может содержать "баги", тестируется. Буду рад предложениям по его развитию.

 Скачать WordHTMLZipper в архиве .ZIP (244 Кб)

А нельзя ли проще?

Можно. Например, нетрудно сжать WordHTML в самом Word. Ведь 99% избыточности Word'овского HTML связано всего с несколькими тегами и атрибутами, а Word прекрасно умеет использовать при замене строк встроенную в офис версию регулярных выражений (Правка, Заменить..., опция "Подстановочные знаки").

В общем, делаем так:

1. Сохраняем документ Word в формате "Web-страница с фильтром" (Файл, Сохранить как...)

2. Сохранённому файлу меняем расширение, например, на .txt

3. Открываем файл из Word уже как текст (Файл, Открыть, Тип файлов: Все файлы (*.*), найти наш файл).

4. Выполняем в документе приведённый ниже макрос (или ему подобный). Лучше сохранить такой макрос в шаблоне документа по умолчанию (Normal.dot) Если не знаете, как это сделать - посмотрите в этой статье (раздел "Подготовка макроса в Word").

Sub Макрос1()
 ' С WildCards
 FromWildcards = Array("--*--", "class=MsoNormal", "class=* ", "style='*'", "lang=EN-US", "lang=RU", "width=* ", _
  " ", "  ", "span ^13", "span^13")
 ToWildCards = Array("", "", "", "", "", "", "", _
  " ", " ", "span", "span")
 ' Без WildCards
 FromNoWildcards = Array(" >", "<p> </p>", "<p></p>", "<span>", "</span>", "<!>", "^13>")
 ToNoWildcards = Array(">", "", "", "", "", "", ">")
For K = 0 To 1
 For i = 0 To UBound(FromWildcards)
  Selection.HomeKey Unit:=wdStory
  Selection.Find.ClearFormatting
  Selection.Find.Replacement.ClearFormatting
  With Selection.Find
   .Text = FromWildcards(i)
   .Replacement.Text = ToWildCards(i)
   .Forward = True
   .Wrap = wdFindContinue
   .Format = False
   .MatchCase = False
   .MatchWholeWord = False
   .MatchAllWordForms = False
   .MatchSoundsLike = False
   .MatchWildcards = True
  End With
  Selection.Find.Execute Replace:=wdReplaceAll
 Next i
 For i = 0 To UBound(FromNoWildcards)
  Selection.HomeKey Unit:=wdStory
  Selection.Find.ClearFormatting
  Selection.Find.Replacement.ClearFormatting
  With Selection.Find
   .Text = FromNoWildcards(i)
   .Replacement.Text = ToNoWildcards(i)
   .Forward = True
   .Wrap = wdFindContinue
   .Format = False
   .MatchCase = False
   .MatchWholeWord = False
   .MatchAllWordForms = False
   .MatchSoundsLike = False
   .MatchWildcards = False
  End With
  Selection.Find.Execute Replace:=wdReplaceAll
 Next i
Next K
End Sub

Нетрудно заметить, что шаги 1-3 тоже можно автоматизировать. Для надёжности макрос делает 2 прохода (внешний цикл по K), на каждом из которых заменяются сначала цепочки с подстановочными знаками, а затем без них.

гостевая; E-mail