mail mail
Нужен макрос для Excel?
Сделайте заказ прямо сейчас!
Ищете готовое решение?
Выбирайте и покупайте!
У вас есть интернет-магазин?
Настроим парсер под любой сайт!

Экспорт выделенного диапазона ячеек в HTML код

Макрос предназначен для экспорта выделенного диапазона ячеек книги Excel в код HTML.

 

Результат (HTML код таблицы) помещается в буфер обмена.

Первая строка выделенного диапазона ячеек считается заголовком таблицы (обрамляется тегами <th> вместо <td>)

 

Например, мы имеем изначально такую таблицу Excel, где мы выделили диапазон ячеек A1:D9

исходная таблица Excel для экспорта в HTML

Запускаем макрос - и в буфере обмена Windows появляется следующий HTML-код:

результат экспорта таблицы в HTML

 

После вставки этого кода на веб-страницу, видим следующее:

 

ФИО Правильный результат склонения Новая формула - DativeCase Совпадение
БАРАШ Лев Юрьевич БАРАШУ Льву Юрьевичу Барашу Льву Юрьевичу ИСТИНА
Абраамян Оганес Дереникович Абраамяну Оганесу Дерениковичу Абраамяну Оганесу Дерениковичу ИСТИНА
Абрамян Артур Александрович Абрамяну Артуру Александровичу Абрамяну Артуру Александровичу ИСТИНА
Абрамян Назар Вачаганович Абрамяну Назару Вачагановичу Абрамяну Назару Вачагановичу ИСТИНА
Абросимов Антон Владимирович Абросимову Антону Владимировичу Абросимову Антону Владимировичу ИСТИНА
АГАФОНОВ Иван Николаевич АГАФОНОВУ Ивану Николаевичу Агафонову Ивану Николаевичу ИСТИНА
Агафонов Константин Викторович Агафонову Константину Викторовичу Агафонову Константину Викторовичу ИСТИНА
Агеев Антон Сергеевич Агееву Антону Сергеевичу Агееву Антону Сергеевичу ИСТИНА

 

Собственно, сам код макроса для экспорта таблицы Excel в HTML:

Sub ExportHTML()
    ' макрос для экспорта выделенного диапазона ячеек в HTML
    On Error Resume Next
    Selection.Areas(1).Select    ' на случай выделения несвязанных диапазонов

    iFirstLine = Selection.Row
    iFirstCol = Selection.Column
    iLastLine = iFirstLine + Selection.Rows.Count - 1
    iLastCol = iFirstCol + Selection.Columns.Count - 1
 
    'HTML классы для таблицы и четного ряда данных
    sTableClass = "ExcelTable"
    sOddRowClass = "odd"
 
    sOutput = "<div><table class='" & sTableClass & "' border=1 width=500px align=center>"    ' Начинаем таблицу
    'sOutput = sOutput & "<caption>" & Cells(iFirstLine, iFirstCol).Text & "</caption>"

    For k = iFirstLine To iLastLine    ' Обрабатываем Excel таблицу
        If (k \ 2 <> k / 2) Then    'проверяем на четность
            sLine = "<tr class ='" & sOddRowClass & "'>"
        Else
            sLine = "<tr>"
        End If
 
        iCountColspan = 0    'счетчик объединенных ячеек
        For j = iFirstCol To iLastCol
            'Проверяем, не объединена ли эта ячейка с соседними.
            If Cells(k, j).MergeCells = True Then
                'Получаем число объединенных ячеек
                iCountColspan = Cells(k, j).MergeArea.Count
            Else
                iCountColspan = 0
            End If
            Set oCurrentCell = ActiveSheet.Cells(k, j)
            sLine = sLine & "<td"
 
            'Проверяем, нужно ли вставлять код объединения ячейки с соседними
            If iCountColspan > 1 Then
                sLine = sLine & " colspan=" & iCountColspan
                j = j + iCountColspan - 1    'пропускаем ячейки
                iCountColspan = 0
            End If
 
            'Если по центру
            If oCurrentCell.HorizontalAlignment = -4108 Then sLine = sLine & " style='text-align: center;'"
            sLine = sLine & ">"
 
            'Если пусто, прописываем &nbsp;
            If oCurrentCell.Text <> "" Then sValue = oCurrentCell.Text Else sValue = "&nbsp;"
            'Если жирный
            If oCurrentCell.Font.Bold = True Then sValue = "<b>" & sValue & "</b>"
            'Если курсив
            If oCurrentCell.Font.Italic = True Then sValue = "<i>" & sValue & "</i>"
 
            sLine = sLine & sValue & "</td>"
            If k = iFirstLine Then sLine = Replace(sLine, "<td", "<th")
 
        Next j
        sOutput = sOutput & sLine & "</tr>"
    Next k
 
    sOutput = sOutput & "</table></div>"  'Заканчиваем таблицу

    ' Копируем полученный HTML в буфер обмена
    With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .SetText sOutput: .PutInClipboard
    End With
End Sub

 

PS: За основу взят код из блога Максима Тарлюн

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

Здравствуйте, Роман
Да, можно и сразу в файл
Замените код

' Копируем полученный HTML в буфер обмена
    With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .SetText sOutput: .PutInClipboard
    End With

на
    filename = "c:\test.html" ' задаём здесь полный путь к файлу
    Set fso = CreateObject("scripting.filesystemobject")
    Set ts = fso.CreateTextFile(filename, True, True)
    ts.Write txt: ts.Close
    Set ts = Nothing: Set fso = Nothing

Спасибо за макрос!
Есть вопрос можно ли сохранять выполнение не в буфер обмена а сразу в файл HTML?

Добрый день

очень интересует эта возможность

------- Можно и цвет передать, и гиперссылки корректно обработать.
Но это надо дорабатывать код.
Если готовы оплатить доработку, - сделаем. ------

нужны все атрибуты - границы,цвета ячеек и ссылки..
Как бы мне получить такой макрос?

А если надо с объединениями по столбцам и по строкам, тогда можно сделать так:

sOutput = ""
For j = iFirstCol To iLastCol
If Cells(k, j) <> "" Then
If Cells(k, j).MergeArea.Count > 1 Then
SpanedCell = "" & Cells(k, j) & ""
rSpan0 = " rowspan=" & Chr(34) & 1 & Chr(34)
SpanedCell = Replace(SpanedCell, rSpan0, "")

cSpan0 = " colspan=" & Chr(34) & 1 & Chr(34)
SpanedCell = Replace(SpanedCell, cSpan0, "")
ce = ce & SpanedCell
Else
ce = ce & "" & Cells(k, j) & ""
End If
Else
If Cells(k, j).MergeArea.Count = 1 Then ce = ce & " "
End If
Next j
If k = iFirstLine Then ce = Replace(ce, "td", "th")
r = r & ce & ""
'MsgBox r
Next k

sOutput = sOutput & r & ""
[K1] = sOutput

Можно и цвет передать, и гиперссылки корректно обработать.
Но это надо дорабатывать код.
Если готовы оплатить доработку, - сделаем.

удалось ли передать цвет ячейки в таблицу? и есть ли возможность содержание гиперссылки этим же макросом отправлять в таблицу?

Подскажите как в таблицу передать цвет заливки ячейки ?

Нет, не поменяется
Макрос выгружает в HTML ТЕКУЩИЕ ЗНАЧЕНИЯ из таблицы
Если надо отобразить обновляемую таблицу Excel на сайте, - есть другие решения (например, библиотеки на PHP для вывода таблиц Excel), а макросы тут вообще ни при чем.

Вопрос такой! Если я изменю значение в Excel, поменяется ли отображение на веб-страничке?

Увы, по Mac ничего подсказать не могу, - не на чем протестировать даже.

Самый простой способ - выводите результат на новый лист Excel

Спасибо за макрос, а подскажите плиз, под Эксель в MacOS какие нужно внести изменения, чтобы в буфер кидало результат?

Спасибо

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
  _       ____    ____    _____   ___         
| |__ | __ ) | ___| | ___| |_ _| __ _
| '_ \ | _ \ |___ \ | |_ | | / _` |
| | | | | |_) | ___) | | _| | | | (_| |
|_| |_| |____/ |____/ |_| |___| \__, |
|___/
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.