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

@Ципихович Эндрю · Регистрация: 10.04.2009

Студворк — интернет-сервис помощи студентам

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

SoftIce · 05.09.2011, 10:56

По-моему в начале нужно добавить html/ и в конце?

@Ципихович Эндрю · 05.09.2011, 11:29 **[ТС]**

сейчас ещё хуже, Ваш совет проверить не могу, на строке

Visual Basic
1
Matrix(Row, Col) = Mid$(t, n, i - n)

получаю ошибку 9 Subscript out of range Индекс вне заданного диапазона
Как лечить???

SoftIce · 05.09.2011, 11:57

А у вас массив Matrix двумерный?

Добавлено через 15 минут
Matrix(t, Row, Col) = Mid$(t, n, i - n)

Добавлено через 50 секунд

@Ципихович Эндрю · 05.09.2011, 12:19 **[ТС]**

Сообщение от SoftIce.net

А у вас массив Matrix двумерный?

я в прогу не вникал, просто вчера работала, сегодня нет, значит работает по чётным

)), спасибо попробую

Добавлено через 16 минут

Сообщение от SoftIce.net

Matrix(t, Row, Col) = Mid$(t, n, i - n)

так не катит ошибка 13 Type mismath
А ошибка то возникает в зависимости сколько столбцов в скопированной таблице Ворда, если 6 то ошибка, если 2 то нет

SoftIce · 05.09.2011, 12:26

Да, смешение типов. t-стринг.

Добавлено через 3 минуты
А потом - иф т=0 то - такая надпись в таблице
иф т=1 то другая.

@Ципихович Эндрю · 12.09.2011, 05:49 **[ТС]**

не стал разбираться в чужом примере, написал свой, правда на ВБА, но он с ВБ как родной, для HTML писал впервые, потому там много комментариев, выложу код, работает так - ставите внутрь таблица курсор и запускаете, вопрос в чём, подправьте кто знает как сделать чтобы в таблице HTML появилась сетка, а также как заточить его строго под ВБ6, спасибо:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
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

Новые блоги и статьи Все статьи Все блоги /
PhpStorm 2025.3: WSL Terminal всегда стартует в ~ and_y87 14.12.2025 PhpStorm 2025. 3: WSL Terminal всегда стартует в ~ (home), игнорируя директорию проекта Симптом: После обновления до PhpStorm 2025. 3 встроенный терминал WSL открывается в домашней директории. . .	Как объединить две одинаковые БД Access с разными данными VikBal 11.12.2025 Помогите пожалуйста !! Как объединить 2 одинаковые БД Access с разными данными.	Новый ноутбук volvo 07.12.2025 Всем привет. По скидке в "черную пятницу" взял себе новый ноутбук Lenovo ThinkBook 16 G7 на Амазоне: Ryzen 5 7533HS 64 Gb DDR5 1Tb NVMe 16" Full HD Display Win11 Pro	Музыка, написанная Искусственным Интеллектом volvo 04.12.2025 Всем привет. Некоторое время назад меня заинтересовало, что уже умеет ИИ в плане написания музыки для песен, и, собственно, исполнения этих самых песен. Стихов у нас много, уже вышли 4 книги, еще 3. . .	От async/await к виртуальным потокам в Python IndentationError 23.11.2025 Армин Ронахер поставил под сомнение async/ await. Создатель Flask заявляет: цветные функции - провал, виртуальные потоки - решение. Не threading-динозавры, а новое поколение лёгких потоков. Откат?. . .
Поиск "дружественных имён" СОМ портов Argus19 22.11.2025 Поиск "дружественных имён" СОМ портов На странице: https:/ / norseev. ru/ 2018/ 01/ 04/ comportlist_windows/ нашёл схожую тему. Там приведён код на С++, который показывает только имена СОМ портов, типа,. . .	Сколько Государство потратило денег на меня, обеспечивая инсулином. Programma_Boinc 20.11.2025 Сколько Государство потратило денег на меня, обеспечивая инсулином. Вот решила сделать интересный приблизительный подсчет, сколько государство потратило на меня денег на покупку инсулинов. . . .	Ломающие изменения в C#.NStar Alpha Etyuhibosecyu 20.11.2025 Уже можно не только тестировать, но и пользоваться C#. NStar - писать оконные приложения, содержащие надписи, кнопки, текстовые поля и даже изображения, например, моя игра "Три в ряд" написана на этом. . .	Мысли в слух kumehtar 18.11.2025 Кстати, совсем недавно имел разговор на тему медитаций с людьми. И обнаружил, что они вообще не понимают что такое медитация и зачем она нужна. Самые базовые вещи. Для них это - когда просто люди. . .	Создание Single Page Application на фреймах krapotkin 16.11.2025 Статья исключительно для начинающих. Подходы оригинальностью не блещут. В век Веб все очень привыкли к дизайну Single-Page-Application . Быстренько разберем подход "на фреймах". Мы делаем одну. . .

@Ципихович Эндрю 1707 / 576 / 74 Регистрация: 10.04.2009 Сообщений: 9,291

	Считать таблицу из буфера и преобразовать ее в html код 04.09.2011, 22:41. Показов 1649. Ответов 6 Метки нет (Все метки) Есть пример программы, которая считывает таблицу из буфера и преобразует ее в html код. http://vbcorner.narod.ru/sample/htmltable.zip Никто не знает как допилить, таблицу Ворда копирую, вставляю в прогу, она преобразует, затем таблица в браузере отображается не так как нужно, просто код, спасибо 0

SoftIce es geht mir gut 11274 / 4760 / 1183 Регистрация: 27.07.2011 Сообщений: 11,439
	05.09.2011, 10:56
	По-моему в начале нужно добавить html/ и в конце? 0

SoftIce es geht mir gut 11274 / 4760 / 1183 Регистрация: 27.07.2011 Сообщений: 11,439
	05.09.2011, 11:57
	А у вас массив Matrix двумерный? Добавлено через 15 минут Matrix(t, Row, Col) = Mid$(t, n, i - n) Добавлено через 50 секунд 1

SoftIce es geht mir gut 11274 / 4760 / 1183 Регистрация: 27.07.2011 Сообщений: 11,439
	05.09.2011, 12:26
	Да, смешение типов. t-стринг. Добавлено через 3 минуты А потом - иф т=0 то - такая надпись в таблице иф т=1 то другая. 0