VBNet - Форум - Макрос doc2htm

Вопрос: Макрос doc2htm Добавлено: 17.11.06 20:15

Автор вопроса: ZagZag | ICQ: 295002202

Как-то очень давно начал делать макрос для сохранения документа Word как
HTML-страницы. Как вы, наверное, знаете сам Word это делает очень некрасиво
(размер получаемой страницы никаким образом не годится для выставления ее в
сеть).
Приведу небольшой алгоритм макроса

1. Составление CSS из стилей "тела", абзацев, текста и т.п.
2. Вытаскивание рисунков из документа и сохранение их в оптимальном формате
3. Перегонка основного текста в HTML
4. Соединение рисунков и CSS с HTML-страницей

Пока реализовано только формирование CSS, и то, неполностью :)

Option Explicit
Private arAlphabit() As String

Sub ViewStyles()
Dim intStyleIndex As Integer
Dim strMsg As String
Dim bolTmp As Boolean

ActiveWindow.Selection.Select

'MsgBox WdBuiltinStyle

For intStyleIndex = 1 To ActiveDocument.Styles.Count - 1
    With ActiveDocument.Styles.Item(intStyleIndex)
    If .InUse = True Then
        strMsg = strMsg & GetTranslitText(.NameLocal) & vbCrLf
        strMsg = strMsg & "{" & vbCrLf

'       FONT-FAMILY:        &FontName&;         (название)
        strMsg = strMsg & vbTab & "FONT-FAMILY:" & .Font.Name & ";" & vbCrLf

'       FONT-SIZE:      ##pt;                   (размер)
        strMsg = strMsg & vbTab & "FONT-SIZE:" & .Font.Size & "pt;" & vbCrLf

'       COLOR:              #RRGGBB;            (цвет символов)
        strMsg = strMsg & vbTab & "COLOR:" & GetHexColor(.Font.Color) & ";"
& vbCrLf

'       FONT-WEIGHT: bold | [normal];
        If .Font.Bold Then
            strMsg = strMsg & vbTab & "FONT-WEIGHT:bold;" & vbCrLf
        End If

'       TEXT-DECORATION: none | [underline]; (подчёркивание)
        If .Font.Underline Then
            strMsg = strMsg & vbTab & "TEXT-DECORATION:underline;" & vbCrLf
        End If

        strMsg = strMsg & "}" & vbCrLf & vbCrLf
        End If
    End With
Next
' Тут конечно запись в файл, а не эта лабуда должна стоять
ActiveWindow.Selection.Text = strMsg
End Sub

Private Function GetTranslitText(strText As String) As String
Dim intIndex As Integer
Dim bytChar As Byte
    arAlphabit =
Split("a.b.v.g.d.e.je.z.i.j.k.l.m.n.o.p.r.s.t.u.f.h.c.ch.sh.sch.tz.ii.mz.ee.jy.ja",
".")

    For intIndex = 1 To Len(strText)
        bytChar = Asc(Mid(strText, intIndex, 1)) 'А-Я

        If bytChar = 32 Then bytChar = Asc("_")

        If bytChar >= 224 And bytChar <= 255 Then
            GetTranslitText = GetTranslitText & LCase(arAlphabit(bytChar -
224))
        Else
            If bytChar >= 192 And bytChar <= 223 Then
                GetTranslitText = GetTranslitText &
UCase(arAlphabit(bytChar - 192))
            Else
                GetTranslitText = GetTranslitText & Chr(bytChar)
            End If
        End If
    Next
End Function

Private Function GetHexColor(lngColor As Long) As String
Dim bytR As Byte
Dim bytG As Byte
Dim bytB As Byte

    bytR = lngColor Mod 256
    lngColor = lngColor - lngColor Mod 256
    bytG = lngColor Mod 256
    lngColor = lngColor - lngColor Mod 256
    bytB = lngColor Mod 256

    GetHexColor = "#"

    If bytR < 16 Then GetHexColor = GetHexColor & "0"
    GetHexColor = GetHexColor & Hex(bytR)

    If bytG < 16 Then GetHexColor = GetHexColor & "0"
    GetHexColor = GetHexColor & Hex(bytG)

    If bytB < 16 Then GetHexColor = GetHexColor & "0"
    GetHexColor = GetHexColor & Hex(bytB)

    Select Case GetHexColor
    Case "#000000"
        GetHexColor = "Black"
    Case "#0000FF"
        GetHexColor = "Blue"
    Case "#00FF00"
        GetHexColor = "Green"
    Case "#FF0000"
        GetHexColor = "Red"
    Case "#FFFFFF"
        GetHexColor = "White"
    End Select
End Function

Тут, конечно, надо не транслитировать, а переименовывать по шаблону
"Заголовок 1" = "H1" и т.п.

Стал вопрос с пунктами 2 и 3:
2. Как вообще перечислять рисунки? :)
3. Как это лучше реализовать? Особенно - как быть с таблицами?

Может быть у кого-то уже есть такой макрос или линк есть? еполенитесь кинуть
сюда.
Заранее спасибо.
Ответить

Ответы Всего ответов: 4

Номер ответа: 1 Автор ответа: ZagZag ICQ: 295002202 Вопросов: 87 Ответов: 1684	Профиль \| \| #1	Добавлено: 25.11.06 22:11
	Гм. Море ответов Неужели никаких наработок в этой области? Ответить

Номер ответа: 2 Автор ответа: HACKER Разработчик Offline Client Вопросов: 236 Ответов: 8362	Профиль \| \| #2	Добавлено: 26.11.06 20:45
	Ну а ты думаешь кто-то пользуется вердом для создания веб страниц для публикации в сеть? Ответить

Номер ответа: 3 Автор ответа: Artyom Разработчик Вопросов: 130 Ответов: 6602	Профиль \| \| #3	Добавлено: 26.11.06 20:54
	Ну я пользуюсь Ответить

Номер ответа: 4 Автор ответа: ZagZag ICQ: 295002202 Вопросов: 87 Ответов: 1684	Профиль \| \| #4	Добавлено: 01.12.06 23:04
	Сорри за задержку - инет дорогой очень Некоторые люди пользуются Вордом, т.к. других средств нету. Я лично предпочитаю MS Visual Studio 2003. Да и мне иногда приходится доки перегонять в HTML, макросом это было бы куда как удобнее и быстрее чем удалять лишние теги вручную (или с помощью RegularExpressions) Ответить

Страница: 1 |