![]() Главная страница Случайная страница КАТЕГОРИИ: АвтомобилиАстрономияБиологияГеографияДом и садДругие языкиДругоеИнформатикаИсторияКультураЛитератураЛогикаМатематикаМедицинаМеталлургияМеханикаОбразованиеОхрана трудаПедагогикаПолитикаПравоПсихологияРелигияРиторикаСоциологияСпортСтроительствоТехнологияТуризмФизикаФилософияФинансыХимияЧерчениеЭкологияЭкономикаЭлектроника |
Преобразование таблицы Excel в HTML-формат
Листинг 3.60. Преобразование таблицы в HTML-формат 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 ' Если перешли на другую строку, то вставляем < tr> If lngRow < > lngLastRow Then strOut = strOut & vbTab & " < /tr> " & vbCrLf & vbTab & _ " < tr> " & vbCrLf ' Переход на следующую строку lngLastRow = lngRow End If
' Задание шрифта ячейки If Not IsNull(cell.Font.Size) Then strStyle = " style=" & " font-size: " & Int(100 * _ cell.Font.Size / 19) & " %; " End If ' Для полужирного шрифта вставляем < b> If cell.Font.Bold Then strCellText = " < b> " & strCellText & " < /b> " 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 = " " ' Печать после каждого символа специального _ разделителя - < br> For i = 1 To Len(strCellText) strTemp = strTemp & Mid$(strCellText, i, 1) & " < br> " Next i strCellText = strTemp strStyle = " " End If
strOut = strOut & vbTab & vbTab & " < td" & strStyle & strAlign _ & " > " & strCellText & " < /td> " & vbCrLf Next ' Вставка < tr> для первой строки и < /tr> - для последней strOut = vbTab & " < tr> " & vbCrLf & strOut & vbTab & " < /tr> " & vbCrLf ' Вставка дескриптора < table> strOut = " < table border=1 cellpadding=3 cellspacing=1> " & vbCrLf & _ strOut & vbCrLf & " < /table> "
' Запускаем Word и показываем в нем сформированный HTML-код Set objWordApp = CreateObject(" Word.Application") objWordApp.documents.Add objWordApp.Selection = strOut objWordApp.Selection.Copy objWordApp.Visible = True Set objWordApp = Nothing End Sub Листинг 3.61. Экспорт данных в HTM-файл Sub ExportAsHtmlFile() 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 strFileName As String ' Имя файла для сохранения HTML-кода Dim i As Long
' Запрос у пользователя имени файла для сохранения strFileName = Application.GetSaveAsFilename(_ InitialFileName: =" Primer.htm", _ fileFilter: =" HTML Files(*.htm), *.htm") ' Проверка, задал ли пользователь имя файла (если нет, _ то можно выходить) If strFileName = " " Then Exit Sub
lngLastRow = Selection.Row ' Просмотр всех выделенных ячеек For Each cell In Selection ' Значение строки для рассматриваемой ячейки lngRow = cell.Row ' Если перешли на другую строку, то вставляем < tr> If lngRow < > lngLastRow Then strOut = strOut & vbTab & " < /tr> " & vbCrLf & vbTab & _ " < tr> " & vbCrLf ' Переход на следующую сроку lngLastRow = lngRow End If
' Задание шрифта ячейки If Not IsNull(cell.Font.Size) Then strStyle = " style=" & " font-size: " & Int(100 * _ cell.Font.Size / 19) & " %; " End If ' Для полужирного шрифта вставляем < b> If cell.Font.Bold Then strCellText = " < b> " & strCellText & " < /b> " 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 = " " ' Печать после каждого символа специального _ разделителя - < br> For i = 1 To Len(strCellText) strTemp = strTemp & Mid$(strCellText, i, 1) & " < br> " Next i strCellText = strTemp strStyle = " " End If
strOut = strOut & vbTab & vbTab & " < td" & strStyle & _ strAlign & " > " & strCellText & " < /td> " & vbCrLf Next ' Вставка < tr> для первой строки и < /tr> - для последней strOut = vbTab & " < tr> " & vbCrLf & strOut & vbTab & " < /tr> " & vbCrLf ' Вставка дескриптора < table> strOut = " < table border=1 cellpadding=3 cellspacing=1> " _ & vbCrLf & strOut & vbCrLf & " < /table> "
' Сохранение HTML-кода в файл Open strFileName For Output As 1 Print #1, strOut Close 1
' Вывод окна с информационным сообщением о результатах работы MsgBox Selection.Count & " ячеек экспортировано в файл " & _ strFileName End Sub
|