Как преобразовать таблицу Excel в HTML с помощью VBA

Excel очень удобно использовать для создания и редактирования таблиц, но иногда готовые данные нужно перенести на веб-сайт в формате HTML. Обычное копирование таблицы из Excel не всегда даёт нужный результат, особенно если необходимо получить чистый HTML-код.

Поэтому я решил написал простой генератор HTML таблиц в Excel.

Как работает генератор HTML таблиц в Excel

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

1. Запустите макрос «HTML_Table_Generator».
2. Выделить ячейки с данными, которые нужно перенести в HTML таблицу.
3. Укажите какие ячейки будут формировать заголовок таблицы. Если выбрать «по горизонтали», то заголовком будет первая горизонтальная строка. Если выбрать «по вертикали», то заголовком будет первый столбец.
4. Нажмите кнопку «Сгенерировать».

После этого приложение автоматически формирует готовую HTML таблицу с указанными заголовками и данными. Вам не нужно создавать теги вручную <table>, <tr>, <th> и <td>, поскольку генератор делает это автоматически.

Как добавить VBA макрос для создания HTML таблиц в Excel

Добавить VBA макрос для создания HTML таблиц в Excel можно двумя способами. Первый вариант подразумевает импорт уже готовой формы и модуля с файлами программы.

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

Второй вариант подойдёт тем, кто хочет создать программу самостоятельно и лучше понять принцип работы VBA в Excel. В этом случае форма создаётся вручную в редакторе Visual Basic, в неё добавляются текстовые поля и кнопки, а затем в соответствующие элементы вставляется необходимый код.

Импорт готовой формы и модуля для генерации HTML таблиц в Excel

Если вы хотите добавить генератор HTML таблиц в Excel, необязательно создавать форму и программный код вручную. Самый простой вариант – загрузить готовые файлы программы и импортировать их в редактор VBA.

Скачать макрос создания HTML таблиц в Excel

Импортировать будем 2 файла – .frm та .bas. Чтобы это сделать правильно, следуйте пошаговой инструкции.

Шаг 1. Загрузите файлы генератора

Загрузите архив с готовыми файлами генератора HTML таблиц. Распакуйте его в любую удобную папку на компьютере.

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

Шаг 2. Откройте редактор VBA

Откройте книгу Excel, в которой вы хотите использовать генератор, и нажмите комбинацию клавиш Alt + F11.

Откроется редактор Microsoft Visual Basic for Applications. Именно здесь находятся формы, модули и другой программный код, используемый макросами Excel.

Шаг 3. Импортируйте форму

В левой части редактора VBA найдите проект открытой книги. Обычно он называется вроде VBAProject (Книга1).

Щёлкните правой кнопкой мыши по проекту и выберите пункт Import File.

В открывшемся окне выбора файла найдите распакованный файл формы с расширением .frm и откройте его.

После этого форма появится в вашем VBA-проекте.

Шаг 4. Импорт модуль

Теперь таким же способом импортируйте файл модуля с расширением .bas.

Щелкните правой кнопкой мыши про проекту книги, выберите Import File, найдите файл модуля и подтвердите импорт.

В результате в проекте должна появиться импортированная форма и стандартный модуль с кодом запуска программы.

Шаг 5. Сохраните книгу в формате с поддержкой макросов

Это очень важный момент. Если книга Excel сохраняется в обычном формате .xlsx, VBA-код в нём храниться не будет.

Поэтому откройте Файл → Сохранить как и выберите формат Книга Excel с поддержкой макросов (*.xlsm).

После сохранения закройте редактор VBA с помощью Alt + F11.

Шаг 6. Запустите генератор HTML таблиц

Вернитесь в Excel и откройте список макросов с помощью Alt + F8.

В списке найдите макрос HTML_Table_Generator, выберите его и нажмите Выполнить.

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

Программа сформирует HTML-код, который можно скопировать и вставить в HTML-документ или редактор сайта.

Самостоятельное создание VBA программы для преобразования таблицы Excel в HTML

Если вы не хотите импортировать готовые файлы, форму генератора можно создать самостоятельно в редакторе VBA. Такой вариант немного длительнее, но позволяет разобраться со строением программы и при необходимости изменить её интерфейс в соответствии с собственными потребностями.

Создание VBA формы

Для начала откройте редактор VBA с помощью комбинации Alt + F11. В меню выберите Insert → UserForm. На листе формы нужно разместить текстовые поля и кнопки, которые будут использоваться для выбора диапазонов, генерации и копирования HTML-кода.

Чтобы программный код правильно взаимодействовал с элементами формы, важно указать для них соответствующие имена в свойстве Name. Также необходимо задать некоторые дополнительные свойства, в том числе размер полей, их режим редактирования и заголовки кнопок.

Чтобы не тратить время на описание каждого свойства в отдельности, все необходимые параметры я свёл в одну таблицу:

Расположение элементов на форме можно изменить по своему усмотрению. Главное — использовать именно те значения свойства Name, которые приведены в таблице, поскольку они непосредственно прописаны в коде VBA. Если назвать, например, поле txtHeaderRange иначе, то соответствующая часть программы не сможет обратиться к нему по старому названию.

После добавления всех элементов останется вставить код в модуль формы. Для этого дважды щелкните по созданному UserForm в редакторе VBA и вставьте код, приведенный ниже.

Option Explicit

' =============================================================================
' ИНИЦИАЛИЗАЦИЯ ФОРМЫ
' =============================================================================
Private Sub UserForm_Initialize()
    txtRange.Value = ""
    txtHTML.Value = ""
    optHorizontal.Value = True
    optVertical.Value = False
End Sub

' =============================================================================
' ВСПОМОГАТЕЛЬНЫЕ ФУНКЦИИ
' =============================================================================
Private Function GetCellValue(cell As Range) As String
    If cell.MergeCells Then
        GetCellValue = Trim(cell.MergeArea.Cells(1, 1).Text)
    Else
        GetCellValue = Trim(cell.Text)
    End If
End Function

Private Function IsMainCell(cell As Range) As Boolean
    If Not cell.MergeCells Then
        IsMainCell = True
    Else
        IsMainCell = (cell.Address = cell.MergeArea.Cells(1, 1).Address)
    End If
End Function

Private Function GetRowspan(cell As Range, currentRow As Long, totalRows As Long) As Long
    If cell.MergeCells Then
        Dim rs As Long
        rs = cell.MergeArea.Rows.Count
        If currentRow + rs - 1 > totalRows Then
            rs = totalRows - currentRow + 1
        End If
        GetRowspan = rs
    Else
        GetRowspan = 1
    End If
End Function

Private Function GetColspan(cell As Range, currentCol As Long, totalCols As Long) As Long
    If cell.MergeCells Then
        Dim cs As Long
        cs = cell.MergeArea.Columns.Count
        If currentCol + cs - 1 > totalCols Then
            cs = totalCols - currentCol + 1
        End If
        GetColspan = cs
    Else
        GetColspan = 1
    End If
End Function

Private Function BuildCellAttr(cell As Range, r As Long, c As Long, totalRows As Long, totalCols As Long) As String
    Dim attr As String
    Dim cs As Long
    Dim rs As Long
    cs = GetColspan(cell, c, totalCols)
    rs = GetRowspan(cell, r, totalRows)
    If cs > 1 Then attr = attr & " colspan=""" & cs & """"
    If rs > 1 Then attr = attr & " rowspan=""" & rs & """"
    BuildCellAttr = attr
End Function

Private Function EscapeHTML(ByVal src As String) As String
    Dim s As String
    s = src
    s = Replace(s, "&", "&")
    s = Replace(s, "<", "&lt;")
    s = Replace(s, ">", "&gt;")
    s = Replace(s, """", "&quot;")
    EscapeHTML = s
End Function

' =============================================================================
' ВЫБОР ДИАПАЗОНА
' =============================================================================
Private Sub cmdSelectRange_Click()
    Dim rng As Range
    
    On Error Resume Next
    Set rng = Application.InputBox( _
        Prompt:="Выделите блок ячеек." & vbCrLf & _
                "• По горизонтали: первая строка – заголовки, остальные – данные" & vbCrLf & _
                "• По вертикали: первая колонка — заголовки, остальные — данные", _
        Title:="Выбор диапазона", _
        Type:=8)
    On Error GoTo 0
    
    If Not rng Is Nothing Then
        txtRange.Value = rng.Address(External:=True)
    End If
End Sub

' =============================================================================
' СГЕНЕРОВАТЬ HTML
' =============================================================================
Private Sub cmdGenerate_Click()
    Dim rng          As Range
    Dim html         As String
    Dim r            As Long
    Dim c            As Long
    Dim totalRows    As Long
    Dim totalCols    As Long
    Dim cell         As Range
    Dim attr         As String
    Dim cs           As Long
    Dim rs           As Long
    Dim rr           As Long
    Dim cc           As Long
    Dim hasContent   As Boolean
    
    ' --- Проверка диапазона ------------------------------------------------
    If Trim(txtRange.Value) = "" Then
        MsgBox "Сначала выберите диапазон ячеек.", vbExclamation, "Не выбран диапазон"
        Exit Sub
    End If
    
    On Error GoTo RangeError
    Set rng = Range(txtRange.Value)
    On Error GoTo 0
    
    totalRows = rng.Rows.Count
    totalCols = rng.Columns.Count
    
    ' --- Проверка размера --------------------------------------------------
    If optHorizontal.Value Then
        If totalRows < 2 Then
            MsgBox "Для режима «По горизонтали» требуется минимум 2 строки:" & vbCrLf & _
                   "1-й — заголовки, 2-й и длее — данные.", vbExclamation, "Мало строк"
            Exit Sub
        End If
    Else
        If totalCols < 2 Then
            MsgBox "Для режима «По вертикали» требуется минимум 2 колонки:" & vbCrLf & _
                   "1-ая — заголовки, 2-ая и далее — данные.", vbExclamation, "Мало колонок"
            Exit Sub
        End If
    End If
    
    ' --- Начало HTML -------------------------------------------------------
    html = "<div class=""table-responsive"">" & vbCrLf
    html = html & "    <table class=""table table-striped"">" & vbCrLf
    
    ' ========================================================================
    ' РЕЖИМ: ПО ГОРИЗОНТАЛИ
    ' ========================================================================
    If optHorizontal.Value Then
        
        ' --- thead (первая строка) ---
        Dim occupiedH() As Boolean
        ReDim occupiedH(1 To 1, 1 To totalCols)
        
        html = html & "        <thead>" & vbCrLf
        html = html & "            <tr>" & vbCrLf
        For c = 1 To totalCols
            If occupiedH(1, c) Then GoTo SkipCellH1
            Set cell = rng.Cells(1, c)
            If IsMainCell(cell) Then
                attr = BuildCellAttr(cell, 1, c, 1, totalCols)
                html = html & "                <th" & attr & ">" & EscapeHTML(GetCellValue(cell)) & "</th>" & vbCrLf
                cs = GetColspan(cell, c, totalCols)
                For cc = c To c + cs - 1
                    If cc <= totalCols Then occupiedH(1, cc) = True
                Next cc
            End If
SkipCellH1:
        Next c
        html = html & "            </tr>" & vbCrLf
        html = html & "        </thead>" & vbCrLf
        
        ' --- tbody (остальные строки) ---
        Dim occupiedB() As Boolean
        ReDim occupiedB(2 To totalRows, 1 To totalCols)
        
        html = html & "        <tbody>" & vbCrLf
        Dim dataRowCount As Long
        dataRowCount = 0
        
        For r = 2 To totalRows
            hasContent = False
            For c = 1 To totalCols
                If Not occupiedB(r, c) And IsMainCell(rng.Cells(r, c)) Then
                    hasContent = True
                    Exit For
                End If
            Next c
            
            If Not hasContent Then GoTo SkipRowH
            
            html = html & "            <tr>" & vbCrLf
            For c = 1 To totalCols
                If occupiedB(r, c) Then GoTo SkipCellH2
                Set cell = rng.Cells(r, c)
                If IsMainCell(cell) Then
                    attr = BuildCellAttr(cell, r, c, totalRows, totalCols)
                    html = html & "                <td" & attr & ">" & EscapeHTML(GetCellValue(cell)) & "</td>" & vbCrLf
                    rs = GetRowspan(cell, r, totalRows)
                    cs = GetColspan(cell, c, totalCols)
                    For rr = r To r + rs - 1
                        For cc = c To c + cs - 1
                            If rr <= totalRows And cc <= totalCols Then
                                occupiedB(rr, cc) = True
                            End If
                        Next cc
                    Next rr
                End If
SkipCellH2:
            Next c
            html = html & "            </tr>" & vbCrLf
            dataRowCount = dataRowCount + 1
SkipRowH:
        Next r
        html = html & "        </tbody>" & vbCrLf
        
        html = html & "    </table>" & vbCrLf
        html = html & "</div>"
        
        MsgBox "HTML-таблица сформирована!" & vbCrLf & _
               "Режим: по горизонтали" & vbCrLf & _
               "Колонок: " & totalCols & ", строк данных: " & dataRowCount, _
               vbInformation, "Готово"
    
    ' ========================================================================
    ' РЕЖИМ: ПО ВЕРТИКАЛИ
    ' ========================================================================
    Else
        
        Dim occupiedV() As Boolean
        ReDim occupiedV(1 To totalRows, 1 To totalCols)
        
        html = html & "        <tbody>" & vbCrLf
        Dim rowCount As Long
        rowCount = 0
        
        For r = 1 To totalRows
            hasContent = False
            For c = 1 To totalCols
                If Not occupiedV(r, c) And IsMainCell(rng.Cells(r, c)) Then
                    hasContent = True
                    Exit For
                End If
            Next c
            
            If Not hasContent Then GoTo SkipRowV
            
            html = html & "            <tr>" & vbCrLf
            For c = 1 To totalCols
                If occupiedV(r, c) Then GoTo SkipCellV
                Set cell = rng.Cells(r, c)
                If IsMainCell(cell) Then
                    attr = BuildCellAttr(cell, r, c, totalRows, totalCols)
                    If c = 1 Then
                        html = html & "                <th" & attr & ">" & EscapeHTML(GetCellValue(cell)) & "</th>" & vbCrLf
                    Else
                        html = html & "                <td" & attr & ">" & EscapeHTML(GetCellValue(cell)) & "</td>" & vbCrLf
                    End If
                    rs = GetRowspan(cell, r, totalRows)
                    cs = GetColspan(cell, c, totalCols)
                    For rr = r To r + rs - 1
                        For cc = c To c + cs - 1
                            If rr <= totalRows And cc <= totalCols Then
                                occupiedV(rr, cc) = True
                            End If
                        Next cc
                    Next rr
                End If
SkipCellV:
            Next c
            html = html & "            </tr>" & vbCrLf
            rowCount = rowCount + 1
SkipRowV:
        Next r
        html = html & "        </tbody>" & vbCrLf
        
        html = html & "    </table>" & vbCrLf
        html = html & "</div>"
        
        MsgBox "HTML-таблица сформирована!" & vbCrLf & _
               "Режим: по вертикали" & vbCrLf & _
               "Строк: " & rowCount & ", колонок данных: " & (totalCols - 1), _
               vbInformation, "Готово"
    End If
    
    txtHTML.Value = html
    Exit Sub

RangeError:
    MsgBox "Не удалось определить диапазон." & vbCrLf & _
           "Убедитесь, что адрес указан правильно, или воспользуйтесь кнопкой «Выбрать диапазон…».", _
           vbCritical, "Помилка"
End Sub

' =============================================================================
' КОПИРОВАНИЕ В БУФЕР
' =============================================================================
Private Sub cmdCopy_Click()
    If Trim(txtHTML.Value) = "" Then
        MsgBox "Сначала сгенерируйте HTML-таблицу.", vbExclamation, "Отсутствуют данные"
        Exit Sub
    End If
    
    Me.txtHTML.SetFocus
    Me.txtHTML.SelStart = 0
    Me.txtHTML.SelLength = Len(Me.txtHTML.Text)
    Me.txtHTML.Copy
    
    MsgBox "HTML-код скопирован в буфер обмена!", vbInformation, "Готово"
End Sub

' =============================================================================
' ОЧИСТКА
' =============================================================================
Private Sub cmdClear_Click()
    txtRange.Value = ""
    txtHTML.Value = ""
    optHorizontal.Value = True
    optVertical.Value = False
    txtRange.SetFocus
End Sub

Создание модуля

Отдельно нужно создать обычный модуль VBA, в который добавляется небольшой макрос запуска формы. Именно его пользователь будет запускать через список доступных макросов Excel.

Откройте редактор VBA с помощью комбинации Alt + F11. В меню выберите Insert → Module. Вставьте этот код в появившееся окно:

Option Explicit

Sub HTML_Table_Generator()
    frmHTMLTableFlex.Show
End Sub

Сохраните книгу в формате с поддержкой макросов.

Таким образом, для полноценной работы генератора нужно создать только форму с вышеперечисленными элементами и один стандартный модуль. Весь основной функционал программы уже реализован в готовом VBA-коде, поэтому вручную писать логику выбора диапазонов, формирование HTML или копирование результата не нужно.