Читаем Excel. Трюки и эффекты полностью

Sub ExportAsHtml()

Dim strStyle As String ' Параметры стиля отображения

ячейки

Dim strAlign As String ' Параметры выравнивания ячейки

Dim strOut As String ' Выходная строка с HTML-кодом

Dim cell As Object ' Обрабатываемая ячейка

Dim strCellText As String ' Текст обрабатываемой ячейки

Dim lngRow As Long ' Номер строки обрабатываемой

ячейки

Dim lngLastRow As Long ' Номер строки предыдущей ячейки

Dim strTemp As String

Dim objWordApp As Object

Dim i As Long

lngLastRow = Selection.Row

' Просмотр всех выделенных ячеек

For Each cell In Selection

' Значение строки для рассматриваемой ячейки

lngRow = cell.Row

' Если перешли на другую строку, то вставляем

If lngRow <> lngLastRow Then

strOut = strOut & vbTab & «» & vbCrLf & vbTab & _

«» & vbCrLf

' Переход на следующую строку

lngLastRow = lngRow

End If

' Задание шрифта ячейки

If Not IsNull(cell.Font.Size) Then

strStyle = « style=» & "font-size: " & Int(100 * _

cell.Font.Size / 19) & «%;»

End If

' Для полужирного шрифта вставляем

If cell.Font.Bold Then

strCellText = «» & strCellText & «»

End If

' Задание выравнивания

If cell.HorizontalAlignment = xlRight Then

' По правому краю

strAlign = « align=» & «right»

ElseIf cell.HorizontalAlignment = xlCenter Then

' По центру

strAlign = « align=» & «center»

Else

' По левому краю (по умолчанию)

strAlign = ""

End If

' Чтение текста в ячейке

strCellText = cell.Text

' Если нужно, то вертикальный вывод текста (в строку strTemp _

с последующим перенесением обратно в strCellText)

If cell.Orientation <> xlHorizontal Then

strTemp = ""

' Печать после каждого символа специального _

разделителя –

For i = 1 To Len(strCellText)

strTemp = strTemp & Mid$(strCellText, i, 1) & «
»

Next i

strCellText = strTemp

strStyle = ""

End If

strOut = strOut & vbTab & vbTab & «

strAlign _

& «>» & strCellText & «» & vbCrLf

Next

' Вставка для первой строки и  – для последней

strOut = vbTab & "м & vbCrLf & strOut & vbTab & "м

& vbCrLf

' Вставка дескриптора

strOut = «

vbCrLf & _

strOut & vbCrLf & «»

' Запускаем Word и показываем в нем сформированный HTML-код

Set objWordApp = CreateObject(«Word.Application»)

objWordApp.documents.Add

objWordApp.Selection = strOut

objWordApp.Selection.Copy

objWordApp.Visible = True

Set objWordApp = Nothing

End Sub

При выполнении данного трюка не стоит забывать, что перед запуском макроса следует выделить диапазон ячеек, который предстоит конвертировать в HTML-код.

В результате применения макроса табличные данные, показанные на рис. 3.17, будут преобразованы в следующий HTML-код:

77

345

25

851

44

415

17

25

Читатель, хотя бы немного знакомый с веб-разработками, без труда узнает знакомый стиль HTML-файла. Этот код будет открыт в отдельном окне Microsoft Word, а также скопирован в буфер обмена.