Работа с картинками Word, сохранение в HTML

Когда я решал задачу по выгрузке word-файла в HTML, столкнулся с определенными проблемами. В этой статье я описываю способы их решения.

Картинки в Word

Картинки документа хранятся в коллекциях Shapes (свободные картинки) и InlineShapes (встроенные в текст картинки). Разницы между ними я не понял. Картинка из одного формата может быть переведена в другой. Видимо, тем или иным объектом картинка считается в зависимости от привязки к тексту.

Концепция не очень удачна, т.к. и те и другие объекты имеют одинаковые типы картинок, в результате чего обработчики приходится дублировать.

Картинки бывают встроенными в документ и связанными с файлом. Для связанных картинок известно полное и краткое имя файла, с которым они связаны.

Проблемы сохранения в HTML

При сохранении в HTML неизвестно, в какой файл сохранится картинка. Если она прилинкована, то имя файла будет соответствовать имени исходного файла картинки. А вот если она связана, то узнать, в какой файл будет сохранена картинка нельзя.

Особую путаницу вносят рамки, сноски и прочие InlineShapes. Иногда две картинки сохраняются, как одна, а одна картинка, если она повторяется, сохраняется в один файл.

Я воспользовался такой тактикой – перед сохранением удаляю все InlineShapes, не являющиеся картинками. В этом случае можно просто пронумеровать по порядку картинку и получить с большой степенью достоверности имя файла в формате имяфайла_001.jpg, где имяфайла – имя сохраняемого файла, 001 – порядковый номер картинки, jpg – расширение. Для InlineShapes расширение может быть и gif.

Если картинка встроена в документ, то в HTML формате она получается такого же размера, как отображается в Word. Если требуется получить картинку исходного размера, можно выполнить еще одно сохранение документа, при этом удалив все лишние картинки, а нужные картинки увеличив до 100% от оригинала:

For Each Shape In EmbeddedImages

EmbeddedCount = EmbeddedCount + 1

Set NewShape = Shape.ConvertToShape

NewShape.ScaleHeight 1, True

NewShape.ScaleWidth 1, True

Для прилинкованные картинок, даже если они большие, не сохраняются эскизы. Используются оригиналы картинок, просто для них указывается нужный размер ширины и высоты в теге IMG. В результате для прилинкованных картинок эскизы получаются большими и долго грузятся, даже если картинка уменьшена.

Единственный вариант решения проблемы – установить в истину свойство Shape.LinkFormat.SavePictureWithDocument. Но у InlineShapes при таком свойстве также проявляется глюк с восстановлением исходного размера картинки.

Проблемы обработки картинок

Если для InlineShape назначить гиперссылку, то она почему-то удаляется из документа и пересоздается по новому, уже с оригинальным размером картинки. Столкнулся с неприятным моментом – после назначения гиперссылки у меня в документе появились картинки большого размера на месте обычных. Посмотрел отладчиком – после добавления объекта объект Shape перестает существовать, причины непонятны:

Set NewHyperLink = Document.Hyperlinks.Add(Shape, NewHyperLinkAddress, Target:="_blank")

Сохранения Word-документа в HTML

Для сохранения в HTML нужно использовать примерно такой каркас.

Сначала нужно создать объект Word:

Set Word = CreateObject("Word.Application")

Затем нужно загрузить в Word doc-файл:

Set Document = Word.Documents.Open(FileName:=FileName, ConfirmConversions _

:=False, ReadOnly:=True, AddToRecentFiles:=False, PasswordDocument:="", _

PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _

WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:="")

Нужно установить опции сохранения документа:

With Document.WebOptions

.RelyOnCSS = True

.OptimizeForBrowser = True

.OrganizeInFolder = False 'Не создавать папку для картинок, размещать файлы в одной папке с htm-файлом

.UseLongFileNames = True

.RelyOnVML = False

.AllowPNG = False

.ScreenSize = msoScreenSize800x600_

.PixelsPerInch = 96

.Encoding = msoEncodingCyrillic_

End With

Затем можно вызывать запись документа в HTM-файл:

Document.SaveAs FileName:=DstFileName, FileFormat:= _

wdFormatFilteredHTML, LockComments:=False, Password:="", AddToRecentFiles _

:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _

:=False, SaveNativePictureFormat:=True, SaveFormsData:=False, _

SaveAsAOCELetter:=False

Формат фильтрованного HTML – наиболее сжатый HTML-формат, из HTML удаляются все лишние данные, остаются только те, что нужны для отображения страницы.

Затем нужно очистить память от всех созданных OLE-объектов, самый простой способ – перебрать процессы, содержащие в командной строке определенные подстроки, указывающие, что это OLE-объект автоматизации Word:

Sub KillAllWordProcesses()

Set Locator = CreateObject("WbemScripting.SWbemLocator")

Set Services = Locator.ConnectServer(".")

Set Items = Services.ExecQuery("SELECT * FROM Win32_Process WHERE NAME LIKE '%WINWORD.EXE%'")

For Each Item In Items

'Debug.Print Item.Name

'Debug.Print Item.CommandLine

'Debug.Print Item.ExecutablePath

'Debug.Print Item.Caption

'Debug.Print "---------------"

If InStr(1, UCase(Item.CommandLine), UCase("/Automation -Embedding")) <> 0 Then

Item.Terminate

End If

End Sub

Пример кода по конвертации из Word в HTM

Выкладываю полный пример кода по конвертации. Особое внимание уделено конвертации картинок.

Sub ConvertDoc2HTMFile(FileName, Optional Word = 0)

'Конвертирует один DOC файл в HTM-файл

If Word = 0 Then

KillAllWordProcesses

Set Word = CreateObject("Word.Application")

End If

wdOpenFormatAuto = 0

msoScreenSize800x600_ = 3

msoEncodingCyrillic_ = 1251

wdFormatFilteredHTML = 10

msoLinkedPicture_ = 11

msoPicture_ = 13

wdInlineShapePicture = 3

wdInlineShapeHorizontalLine = 6

wdInlineShapeLinkedPicture_ = 4

Set fs = CreateObject("Scripting.FileSystemObject")

Set File = fs.GetFile(FileName)

FileShortName = File.Name

FilePath = Left(File.Path, Len(File.Path) - Len(File.Name) - 1)

FileNamePart = Replace(FileShortName, ".doc", "")

FileNamePart = Replace(FileNamePart, ".docx", "")

DstFileName = Replace(FileName, ".doc", ".htm")

DstFileName = Replace(DstFileName, ".docx", ".htm")

If FileName = DstFileName Then

Exit Sub 'Защита от перезаписи файла

End If

Set Document = Word.Documents.Open(FileName:=FileName, ConfirmConversions _

:=False, ReadOnly:=True, AddToRecentFiles:=False, PasswordDocument:="", _

PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _

WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:="")

With Document.WebOptions

.RelyOnCSS = True

.OptimizeForBrowser = True

.OrganizeInFolder = False

.UseLongFileNames = True

.RelyOnVML = False

.AllowPNG = False

.ScreenSize = msoScreenSize800x600_

.PixelsPerInch = 96

.Encoding = msoEncodingCyrillic_

End With

Set Images = New Collection

For Each Shape In Document.InLineShapes

Images.Add Shape

For Each Shape In Document.Shapes

Images.Add Shape

'Images

EmbeddedCount = 0

Set ForDeleteImages = New Collection

Set EmbeddedImages = New Collection

For Each Shape In Images

ForDelete = True

Work = False

Linked = False

InlineLinked = False

Embedded = False

If TypeName(Shape) = "InlineShape" And Shape.Type = wdInlineShapePicture Or _

TypeName(Shape) = "Shape" And Shape.Type = msoPicture_ Then

EmbeddedCount = EmbeddedCount + 1

EmbeddedImages.Add Shape

Work = True

Embedded = True

ElseIf TypeName(Shape) = "Shape" And Shape.Type = msoLinkedPicture_ Then

Linked = True

Work = True

ElseIf TypeName(Shape) = "InlineShape" And Shape.Type = wdInlineShapeLinkedPicture_ Then

'For better saving convert to shape

Linked = True

Work = True

InlineLinked = True

'Shape.ConvertToShape

ElseIf TypeName(Shape) = "InlineShape" Then

Shape.Delete 'Delete, because cannot save correctly

ForDelete = False

Work = False

Else

Work = False

End If

'Проставляем гиперссылку

If Work Then

HyperlinkAddress = ""

On Error Resume Next

HyperlinkAddress = Shape.Hyperlink.Address

On Error GoTo 0

If HyperlinkAddress = "" Then

If Linked Then

SrcFileFullName = Shape.LinkFormat.SourceName & ""

'On Error Resume Next

'Set LinkFile = fs.GetFile(SrcFileFullName)

NewHyperLinkAddress = SrcFileFullName 'LinkFile.Name

If InlineLinked Then

'Shape.Range.Paragraphs.First

'Set NewHyperLink =
Document.Hyperlinks.Add(Document.Selection, NewHyperLinkAddress, Target:="_blank")

'Set NewShape = Shape.ConvertToShape

'Set NewHyperLink = Document.Hyperlinks.Add(NewShape, NewHyperLinkAddress,

Target:="_blank")

'Set NewHyperLink = Document.Hyperlinks.Add(Shape, NewHyperLinkAddress, Target:="_blank")

Else

Shape.LinkFormat.SavePictureWithDocument = True

Set NewHyperLink = Document.Hyperlinks.Add(Shape, NewHyperLinkAddress, Target:="_blank")

End If

On Error GoTo 0

ElseIf Embedded Then

ForDelete = False

If EmbeddedCount = 78 Then

X = 1

End If

NewHyperLinkAddress = FileNamePart & "__image" & Format(EmbeddedCount, "###000") & ".jpg"

Set NewHyperLink = Document.Hyperlinks.Add(Shape, NewHyperLinkAddress, Target:="_blank")

End If

If ForDelete Then

ForDeleteImages.Add Shape

End If

Document.SaveAs FileName:=DstFileName, FileFormat:= _

wdFormatFilteredHTML, LockComments:=False, Password:="", AddToRecentFiles _

:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _

:=False, SaveNativePictureFormat:=True, SaveFormsData:=False, _

SaveAsAOCELetter:=False

If EmbeddedImages.Count() > 0 Then

EmbeddedCount = 0

NewFileNameForPictures = FilePath & "\" & FileNamePart & "_.htm"

On Error Resume Next

'Удаляем прилинкованные изображения

For Each Shape In ForDeleteImages

Shape.Delete

For Each Shape In EmbeddedImages

EmbeddedCount = EmbeddedCount + 1

Set NewShape = Shape.ConvertToShape

NewShape.ScaleHeight 1, True

NewShape.ScaleWidth 1, True

On Error GoTo 0

Document.SaveAs FileName:=NewFileNameForPictures, FileFormat:= _

wdFormatFilteredHTML, LockComments:=False, Password:="", AddToRecentFiles _

:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts _

:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, _

SaveAsAOCELetter:=False

Document.Close False

Set fs = CreateObject("Scripting.FileSystemObject")

Set File = fs.GetFile(NewFileNameForPictures)

File.Delete

End If

On Error Resume Next

Document.Close False

On Error GoTo 0

End Sub