Экспорт выделенного диапазона ячеек в 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) с отметкой сохранить выделенный лист?

Как-то так можно:

Sub place()
    Dim wfile$, txt$
    wfile = "C:\....\rs.HTM"
 
    ' считываем текст файла в переменную
    txt = ReadTXTfile(wfile)
 
    ' выполняем замены
    txt = Replace(txt, "?", "a")
    txt = Replace(txt, "1", "2")
    txt = Replace(txt, "-", "+")
 
    ' сохраняем результат в тот же файл
    SaveTXTfile wfile, txt
End Sub

Добрый вечер.

В созданном макросе замены никак не могу добавить несколько замен, как это можно реализовать?
Заранее спасибо за ответ
Sub place()
Dim wfile: wfile = "C:\....\rs.HTM"
Application.DisplayAlerts = False
SaveTXTfile wfile, Replace(ReadTXTfile(wfile), "?", "a")
Application.DisplayAlerts = True
End Sub

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

Добрый день.

Формулы работы с тексом обрабатывают файлы до 32 кб, а эксель катастрофически раздувает HTML файлы при сохранении. Возможно ли как то обойти это органичение?

Работаете с файлом HTML также, как с любым другим текстовым файлом
http://excelvba.ru/code/txt

А как макросом внести изменения в HTML? Если Макрос Excel, то как открыть файл HTML в тексовом виде?

Только если потом макросом вносить правки в файл HTML (каждый раз после сохранения)
Т.к. вмешаться в процесс сохранения файла (save as) не получится

Добрый день.

Для оптимизации работы со ссылками на сайте использую фунцию onclick
Пример
Ссылка
При этом иногда ссылки находятся в таблице, которая сохраняется периодически макросом из Excel (save as ...html) в самом ексель ячейки с гиперссылками (пример: HYPERLINK(H6,1), в ячейке Н6 прописано - #" onclick="window.open('http://google.com'); window.open('http://google.com');).

Одна из проблем конвертации, кроме всего прочего, это преобразование двойных кавычек " в " получается -
Ссылка

Как "чайнику" можно решить эту проблему не изменяя файл, сохраненный в html (очень часто обновляется).

Заранее благодарен за ответы.

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

' Копируем полученный 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
Подтвердите, пожалуйста, что вы - человек:
  ____            __             _            
| __ ) __ __ / /_ __ _ / | __ __
| _ \ \ \/ / | '_ \ / _` | | | \ \ /\ / /
| |_) | > < | (_) | | (_| | | | \ V V /
|____/ /_/\_\ \___/ \__, | |_| \_/\_/
|_|
Введите код, изображенный в стиле ASCII-арт.

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

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