Считать таблицу из буфера и преобразовать ее в html код - VB

Узнай цену своей работы

Формулировка задачи:

Есть пример программы, которая считывает таблицу из буфера и преобразует ее в html код. http://vbcorner.narod.ru/sample/htmltable.zip Никто не знает как допилить, таблицу Ворда копирую, вставляю в прогу, она преобразует, затем таблица в браузере отображается не так как нужно, просто код, спасибо

Решение задачи: «Считать таблицу из буфера и преобразовать ее в html код»

textual
Листинг программы 
Option Explicit
 
'vbBlack 0x0 Black Чёрный цвет
'vbRed 0xFF Red Красный цвет
'vbGreen 0xFF00 Green Зелёный цвет
'vbYellow 0xFFFF Yellow Жёлтый цвет
'vbBlue 0xFF0000 Blue Пурпурный цвет
'vbMagenta 0xFF00FF Magenta цвет
'vbCyan 0xFFFF00 Cyan Голубой цвет
'vbWhite 0xFFFFFF White Белый цвет
 
'"-16777216" цвет ауто
'"0" чёрный цвет
'"255" красный цвет
'"16711680" синий цвет
'"32768" зелёный цвет
'"65535" жёлтый цвет
'"16711935" лиловый цвет
 
'тёмно жёлтый цвет
Const Цвет_тёмно_жёлтый = "#FFCC33"
''''''''''''''''''''''
 
Sub Tables_Word_в_таблицу_HTML()
 
'отключаем дёргание экрана при выполнении кода
    Application.ScreenUpdating = False
 
    'объявление переменной типа "Integer"
    'этим переменным можно присваивать только целочисленные значения, размер 2 байта, от -32768 до + 32767
    Dim cursor_table As Integer
    Dim cursor_row As Integer
    Dim cursor_column_cell As Integer
 
    'выполнить функцию с именем ...
    FunctionВыясняем_нахождение_курсора_в_таблице _
            cursor_table, _
            cursor_row, _
            cursor_column_cell
 
    'cursor_table = 32767 взято в связи с тем, что переменная cursor_table имеет тип данных Integer
    'тип данных Integer может иметь максимальное значение 32767
    If cursor_table = 32767 Then
        MsgBox$ _
                "Курсор должен находится в таблице" & Chr$(13) & _
                                                    "Программа не может быть продолжена", vbOKOnly, _
                                                    "Внимание"
        'перейти к метке с именем ...
        GoTo Конец
    End If
 
    Dim NowDateTime As String
    'заменяем двоеточие на точку
    'так как дата пишется как "11.09.2011 20:44:54"
    'имя файла не может иметь двоеточие
    NowDateTime = Replace$(Now, ":", ".")
    'открыть текстовый файл с именем ... по адресу ...
    'если указанного файла нет, тогда он создаётся программно
    'Open "pathname" For mode As filenumber
    'mode (режим), ключ VBA, определяющий
    'каким образом планируется работать с файлом
    'filenumber (номер файла)
    'аргумент filenumber принимает целочисленное значение от 1 до 511
    'если оно не было присвоено другому файлу
    'традиционно, но не обязательно, в номере перед числом помешают знак #
    Open "C:\" & NowDateTime & ".txt" For Output As #1
    Print #1, "<!Комментарии в html странице>"
    Print #1, "<!Этот тег должен открывать документ>"
    Print #1, "<html>"
    Print #1, "<!Голова документа>"
    Print #1, "<head>"
    Print #1, "<!Заголовок окна Internet Explorer>"
    Print #1, "<title>Таблица Word</title>"
    Print #1, "<!Закрывающий тег головы документа>"
    Print #1, "</head>"
    Print #1, "<!Тело документа>"
    Print #1, "<body>"
    Print #1, "<!Тег таблицы, тег цвета таблицы>"
    Print #1, "<!Если при заданном фоне для всей таблицы, задать фон для ряда или ячейки>"
    Print #1, "<!Тогда этот ряд или ячейка будут иметь фон отличный от всей таблицы>"
    Print #1, "<table bgcolor=" & Цвет_тёмно_жёлтый & ">"
    Print #1, "<!tr - Тег строчки таблицы>"
    Print #1, "<!td - Тег столбца (ячейки) таблицы>"
 
    Dim q As Integer
    Dim w As Integer
    'объявление переменной типа "Строка", размер 1 байт на символ, от 0 до 2 миллиардов
    Dim Строка_таблицы_Word As String
    Dim Начало_сообщения_поля_MACROBUTTON As String
    Dim Нахождение_начала_сообщения_поля_MACROBUTTON As Integer
 
    For q = 1 To ActiveDocument.Tables(cursor_table).Rows.Count
        Print #1, "<tr>"
        For w = 1 To ActiveDocument.Tables(cursor_table).Columns.Count
            If w > ActiveDocument.Tables(cursor_table).Rows(w).Cells.Count Then Exit For
            If q = 1 And _
               ActiveDocument.Tables(cursor_table).Rows(q).Cells(w).Range.Fields.Count = 1 Then
                If ActiveDocument.Tables(cursor_table).Rows(q).Cells(w).Range.Fields(1).Code Like "*MACROBUTTON*" Then
                    Начало_сообщения_поля_MACROBUTTON = Trim$(Split(ActiveDocument.Tables(cursor_table).Rows(q).Cells(w).Range.Fields(1).Code)(2))
                    'InStr([Start,]String1,String2[,Compare])
                    Нахождение_начала_сообщения_поля_MACROBUTTON = InStr(1, ActiveDocument.Tables(cursor_table).Rows(q).Cells(w).Range.Fields(1).Code, Начало_сообщения_поля_MACROBUTTON)
                    'Mid$(String,Start,[Length])
                    Строка_таблицы_Word = Mid$(Trim$(ActiveDocument.Tables(cursor_table).Rows(q).Cells(w).Range.Fields(1).Code), Нахождение_начала_сообщения_поля_MACROBUTTON)
                    GoTo Строка_таблицы_Word_выяснена
                End If
            End If
 
            cursor_row = q
            cursor_column_cell = w
            'выполнить функцию с именем ...
            FunctionRange_со_строки_или_ячейки_таблицы_Word _
                    cursor_table, _
                    cursor_row, _
                    cursor_column_cell, _
                    Строка_таблицы_Word
 
Строка_таблицы_Word_выяснена:
 
            Print #1, "<td>" & Строка_таблицы_Word & "</td>"
        Next w
        Print #1, "</tr>"
    Next q
 
    Print #1, "<!Закрывающий тег таблицы>"
    Print #1, "</table>"
    Print #1, "<!Закрывающий тег тела документа>"
    Print #1, "</body>"
    Print #1, "<!Закрывающий тег HTML страницы>"
    Print #1, "</html>"
 
    Close 1
 
    FileCopy Source:="C:\" & NowDateTime & ".txt", _
             Destination:="C:\" & NowDateTime & ".html"
 
    'удаляем временный документ
    Kill "C:\" & NowDateTime & ".txt"
 
    Beep
 
    MsgBox$ "Конец"
 
Конец:
 
    'отменяем отключение дёргания экрана при выполнении кода
    Application.ScreenUpdating = True
 
End Sub
 
Function FunctionВыясняем_нахождение_курсора_в_таблице( _
         cursor_table, _
         cursor_row, _
         cursor_column_cell)
 
    Dim isTable As Word.Range
    Set isTable = Selection.Range
 
    'условие, если Not isTable.Information(wdWithInTable), тогда курсор находится не в таблице, тогда ...
    'cursor_table = 32767 взято в связи с тем, что переменная cursor_table имеет тип данных Integer
    'тип данных Integer может иметь максимальное значение 32767
    If Not isTable.Information(wdWithInTable) Then
        cursor_table = 32767
        'перейти к метке с именем ...
        GoTo Конец
    End If
 
    'номер таблицы в документе, где расположен курсор
    cursor_table = ActiveDocument.Range(0, Selection.Tables(1).Range.End).Tables.Count
 
    'номер строки в таблице, в документе, где расположен курсор
    cursor_row = Selection.Rows.First.Index
 
    'номер столбца, а также ячейки в таблице, в документе, где расположен курсор, даже если ширина столбца, ячейки различается
    cursor_column_cell = Selection.Cells(1).ColumnIndex
 
Конец:
 
    'установка объекта в значение Nothing требуется для освобождения памяти, которая была выделена для создания этого объекта
    Set isTable = Nothing
 
End Function
 
Function FunctionRange_со_строки_или_ячейки_таблицы_Word( _
         cursor_table, _
         cursor_row, _
         cursor_column_cell, _
         Строка_таблицы_Word)
 
'Range со строки или ячейки таблицы Word
'абзац заменяем на пробел
'заменяем два, три, четыре и более пробелов подряд на один пробел
'удаляем концевую сноску таблицы Word
'заменяем пробел, следом идущую запятую на запятую, то есть, удаляем пробел перед запятой
 
'здесь при помощи Trim$ откидываем лишние пробелы в начале и в конце строки или ячейки таблицы Word
    If cursor_table <> 32767 Then Строка_таблицы_Word = Trim$(ActiveDocument.Tables(cursor_table).Rows(cursor_row).Cells(cursor_column_cell).Range)
    'Debug.Print Строка_таблицы_Word
 
    Dim reg As Object
    Set reg = CreateObject("vbscript.regexp")
    'искать по всему тексту, по умолчанию False - будет найдено только первое совпадение
    reg.Global = True
    'Chr$(13) это абзац, заменяем его на пробел
    reg.Pattern = Chr$(13)
    Строка_таблицы_Word = reg.Replace$(Строка_таблицы_Word, " ")
    'Debug.Print Строка_таблицы_Word
    '+ означает, что заменяем два, три, четыре и более пробелов подряд на один пробел
    reg.Pattern = " +"
    Строка_таблицы_Word = reg.Replace$(Строка_таблицы_Word, " ")
    'Debug.Print Строка_таблицы_Word
    'Chr$(7) это концевая сноска таблицы Word
    reg.Pattern = Chr$(7)
    Строка_таблицы_Word = reg.Replace$(Строка_таблицы_Word, "")
    'Debug.Print Строка_таблицы_Word
    'заменяем пробел, следом идущую запятую на запятую, то есть удаляем пробел перед запятой
    reg.Pattern = " ,"
    Строка_таблицы_Word = reg.Replace$(Строка_таблицы_Word, ",")
    'Debug.Print Строка_таблицы_Word
    Строка_таблицы_Word = Trim$(Строка_таблицы_Word)
    'Debug.Print Строка_таблицы_Word
 
    'установка объекта в значение Nothing требуется для освобождения памяти, которая была выделена для создания этого объекта
    Set reg = Nothing
 
End Function

ИИ поможет Вам:

  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

6   голосов , оценка 4.5 из 5
Похожие ответы