Не могу найти ошибку.

Программирование на Visual Basic for Applications
Павлуша
Не годный к строевой
Не годный к строевой
Аватара пользователя
 
Сообщения: 884
Зарегистрирован: 01.01.2005 (Сб) 19:31
Откуда: Смотря кто?

Не могу найти ошибку.

Сообщение Павлуша » 24.12.2015 (Чт) 10:50

Доброго времени суток, дорогие форумчане!

Столкнулся с проблемой...
Есть макрос, который сохраняет выделенные ячейки 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

Пошли все на фиг, я фея! :flower:

Павлуша
Не годный к строевой
Не годный к строевой
Аватара пользователя
 
Сообщения: 884
Зарегистрирован: 01.01.2005 (Сб) 19:31
Откуда: Смотря кто?

Re: Не могу найти ошибку.

Сообщение Павлуша » 24.12.2015 (Чт) 11:02

Всё, спасибо.
Проблему нашел самостоятельно))

Чтение содержимого ячейки происходило после проверки стилей. А надо было проверить до.
Разница в 1 строчку, а каков результат, а!)
Пошли все на фиг, я фея! :flower:

Павлуша
Не годный к строевой
Не годный к строевой
Аватара пользователя
 
Сообщения: 884
Зарегистрирован: 01.01.2005 (Сб) 19:31
Откуда: Смотря кто?

Re: Не могу найти ошибку.

Сообщение Павлуша » 24.12.2015 (Чт) 11:55

Увы, придется вернуться к вопросу...

Посмотрите, пожалуйста, исправленный код:

Код: Выделить всё

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 c 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
      ' Чтение цвета в ячейке
       strCellCol = cell.Interior.ColorIndex
     
      ' Если перешли на другую строку, то вставляем <tr>
      If lngRow <> lngLastRow Then
         strOut = strOut & vbTab & "</tr>" & vbCrLf & vbTab & "<tr>" & vbCrLf
         ' Переход на следующую сроку
         lngLastRow = lngRow
      End If
     
      ' Задание шрифта ячейки
      strCellCol = cell.Interior.ColorIndex ' Задание цвета ячейка
     
      If Not IsNull(cell.Font.Size) Then
         strStyle = " style=" & "font-size: " & Int(100 * cell.Font.Size / 19) & ", color: " & strCellCol & "%;"
      End If
     
      ' Для полужирного шрифта вставляем <b>
      If cell.Font.Bold Then
          strCellText = "<b>" & strCellText & "</b>"
      End If
     
      'Для курсива вставим <i>
      If cell.Font.Italic = True Then
        strCellText = "<i>" & strCellText & "</i>"
      End If
     
      'If cell.Interior.ColorIndex <> white Then
        'strCellCol = cell.Interior.ColorIndex
        'strStyle = " style=" & "color: " & strCellCol & ";"
      'End If
     
      ' Задание выравнивания
      If cell.HorizontalAlignment = xlRight Then
         ' По правому краю
         strAlign = " align=" & "right"
      ElseIf cell.HorizontalAlignment = xlCenter Then
         ' По центру
         strAlign = " align=" & "center"
      Else
         ' По левому краю (по умолчанию)
         strAlign = ""
      End If
     
     
      ' Если нужно, то вертикальный вывод текста (в строку 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




До меня дошло, что проверка шрифта и считывание цвета ячейки не работают... Вообще.

Вопрос: что я делаю не так?) Ошибка в операторе условия? В синтаксисе проверки и задания цвета ячейки? В синтаксисе HTML кода? Или сразу во всех этих местах?)

Заранее спасибо!
Пошли все на фиг, я фея! :flower:


Вернуться в VBA

Кто сейчас на конференции

Сейчас этот форум просматривают: Yandex-бот и гости: 8

    TopList