Столкнулся с проблемой...
Есть макрос, который сохраняет выделенные ячейки Excel в HTML.
Макрос работает, выделяет, преобразует и сохраняет.
Но! Совершенно не сохраняет форматирование ячейки!
Поясню: в таблице есть ячейки с текстом, написанным жирным шрифтом. В конечном HTML файле жирный шрифт не отображается вообще. Как и курсив или подчеркивание.
Прилагаю код макроса.
Третий день сижу и не могу понять, почему нет отображения стиля текста.
Чую, что проблема где-то на поверхности, но, как говорил кто-то из местных долгожителей: "Когда вы переберете все возможные варианты решения проблемы и не найдете нужного, сразу обнаружится красивое и простое решение, доступное и понятное для всех, кроме вас".
Заранее спасибо!
Код макроса:
- Код: Выделить всё
Sub ExportAsHТМLFile()
Range("B2:C35").Select
Dim strStyle As String ' Параметры стиля отображения ячейки
Dim strAlign As String ' Параметры выравнивания ячейки
Dim strOut As String ' Выходная строка с HТМL-кодом
Dim cell As Object ' Обрабатываемая ячейка
Dim strCellText As String ' Текст обрабатываемой ячейки
Dim lngRow As String ' Номер строки обрабатываемой ячейки
Dim lngLastRow As String ' Номер строки предыдущей ячейки
Dim strTemp As String
Dim strFileName As String ' Имя файла для сохранения HТМL-кода
Dim i As Integer
Dim strDesName As String
'Объявление названия файла для сохранения
strDesName = Range("C3").Text
' Запрос у пользователя имени файла для сохранения
strFileName = Application.GetSaveAsFilename(InitialFileName:=strDesName, fileFilter:="HТМL Files(*.html), *.html")
' Проверка, задал ли пользователь имя файла (если нет, то можно выходить)
If strFileName = "" Then Exit Sub
lngLastRow = Selection.Row
' Просмотр всех выделенных ячеек
For Each cell In Selection
' Значение строки для рассматриваемой ячейки
lngRow = cell.Row
' strCellText = cell.Text
' Если перешли на другую строку, то вставляем <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 = True Then
strCellText = "<b>" & strCellText & "</b>"
End If
'Для курсива вставим <i>
If cell.Font.Italic = True Then
strCellText = "<i>" & strCellText & "</i>"
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>"
' Сохранение HТМL-кода в файл
Open strFileName For Output As 1
Print #1, strOut
Close 1
' Вывод окна с информационным сообщением о результатах работы
MsgBox Selection.Count & " ячеек экспортировано в файл " & strFileName
End Sub
