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

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

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

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

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

Запускаем макрос - и в буфере обмена Windows появляется следующий 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: За основу взят код из блога Максима Тарлюн

26333 просмотра

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

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

Андрей, 29 Май 2018 - 11:04.#1

Вопрос, а как вызвать диалоговое окно сохранения как Веб-страница(.html) с отметкой сохранить выделенный лист?

Игорь (администратор сайта), 26 Май 2017 - 00:06.#2

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

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

Гость, 25 Май 2017 - 22:28.#3

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

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

Игорь (администратор сайта), 24 Май 2017 - 20:54.#4

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

Гость, 24 Май 2017 - 20:22.#5

Добрый день.

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

Игорь (администратор сайта), 22 Май 2017 - 21:32.#6

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

Гость, 22 Май 2017 - 21:01.#7

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

Игорь (администратор сайта), 22 Май 2017 - 20:56.#8

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

Гость, 22 Май 2017 - 20:29.#9

Добрый день.

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

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

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

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

Игорь (администратор сайта), 30 Мар 2016 - 15:35.#10

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

' Копируем полученный 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

Роман, 30 Мар 2016 - 15:11.#11

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

Гость, 10 Фев 2016 - 14:21.#12

Добрый день

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

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

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

Димон, 25 Дек 2014 - 22:03.#13

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

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

Игорь (администратор сайта), 10 Дек 2014 - 14:35.#14

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

Гость, 10 Дек 2014 - 14:09.#15

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

Гость, 16 Ноя 2014 - 09:09.#16

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

Игорь (администратор сайта), 15 Авг 2014 - 00:27.#17

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

Гость, 15 Авг 2014 - 00:15.#18

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

Игорь (администратор сайта), 28 Июл 2014 - 19:48.#19

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

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

macoco, 28 Июл 2014 - 17:40.#20

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

Гость, 19 Апр 2014 - 16:35.#21

Спасибо

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

Комментарии

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

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

НАДСТРОЙКИ ДЛЯ EXCEL