Я искал подход, отличный от подхода mnmnc.
Мои попытки сохранить тестовый документ Word в формате HTML не увенчались успехом. В прошлом я обнаружил, что HTML, сгенерированный Office, настолько переполнен, что выделять нужные биты практически невозможно. Я обнаружил, что это имеет место здесь. У меня также была проблема с уравнениями. Слово сохраняет уравнения в виде изображений. Для каждого уравнения будет два изображения, одно с расширением WMZ и одно с расширением GIF. Если вы отображаете html-файл с помощью Google Chrome, уравнения выглядят хорошо, но не замечательно; внешний вид соответствует файлу GIF при отображении с помощью инструмента отображения / редактирования изображений, который может обрабатывать прозрачные изображения. Если вы отображаете HTML-файл с помощью Internet Explorer, уравнения выглядят идеально.
Дополнительная информация
Я должен был включить эту информацию в первоначальный ответ.
Я создал небольшой документ Word, который я сохранил как HTML. Три панели на изображении ниже показывают исходный документ Word, HTML-документ, отображаемый в Microsoft Internet Explorer, и HTML-документ, отображаемый в Google Chrome.
Как объяснялось ранее, разница между изображениями IE и Chrome является результатом того, что уравнения сохраняются дважды, один раз в формате WMZ и один раз в формате GIF. HTML слишком велик, чтобы показать здесь.
HTML, созданный макросом:
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Frameset//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
<head><meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
</head><body>
<p>Some ordinary text.</p>
<p>H<sub>2</sub>SO<sub>4</sub>.</p>
<p>Abc & def > ghi < jkl</p>
<p>x<sup>3</sup>+ x<sup>2</sup>+3x+4=0.</p><p></p>
<p><i>Equation</i> </p>
<p>Mno</p>
<p><i>Equation</i></p>
</body></html>
Который отображается как:
Я не пытался преобразовать уравнения, так как бесплатный MathType Software Development Kit, очевидно, включает в себя процедуры, которые конвертируют в LaTex
Код довольно простой, поэтому не так много комментариев. Спросите, если что-то неясно. Примечание: это улучшенная версия исходного кода.
Sub ConvertToHtml()
Dim FileNum As Long
Dim NumPendingCR As Long
Dim objChr As Object
Dim PathCrnt As String
Dim rng As Word.Range
Dim WithinPara As Boolean
Dim WithinSuper As Boolean
Dim WithinSub As Boolean
FileNum = FreeFile
PathCrnt = ActiveDocument.Path
Open PathCrnt & "\TestWord.html" For Output Access Write Lock Write As #FileNum
Print #FileNum, "<!DOCTYPE html PUBLIC ""-//W3C//DTD XHTML 1.0 Frameset//EN""" & _
" ""http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd"">" & _
vbCr & vbLf & "<html xmlns=""http://www.w3.org/1999/xhtml"" " & _
"xml:lang=""en"" lang=""en"">" & vbCr & vbLf & _
"<head><meta http-equiv=""Content-Type"" content=""text/html; " _
& "charset=utf-8"" />" & vbCr & vbLf & "</head><body>"
For Each rng In ActiveDocument.StoryRanges
NumPendingCR = 0
WithinPara = False
WithinSub = False
WithinSuper = False
Do While Not (rng Is Nothing)
For Each objChr In rng.Characters
If objChr.Font.Superscript Then
If Not WithinSuper Then
' Start of superscript
Print #FileNum, "<sup>";
WithinSuper = True
End If
ElseIf WithinSuper Then
' End of superscript
Print #FileNum, "</sup>";
WithinSuper = False
End If
If objChr.Font.Subscript Then
If Not WithinSub Then
' Start of subscript
Print #FileNum, "<sub>";
WithinSub = True
End If
ElseIf WithinSub Then
' End of subscript
Print #FileNum, "</sub>";
WithinSub = False
End If
Select Case objChr
Case vbCr
NumPendingCR = NumPendingCR + 1
Case "&"
Print #FileNum, CheckPara(NumPendingCR, WithinPara) & "&";
Case "<"
Print #FileNum, CheckPara(NumPendingCR, WithinPara) & "<";
Case ">"
Print #FileNum, CheckPara(NumPendingCR, WithinPara) & ">";
Case Chr(1)
Print #FileNum, CheckPara(NumPendingCR, WithinPara) & "<i>Equation</i>";
Case Else
Print #FileNum, CheckPara(NumPendingCR, WithinPara) & objChr;
End Select
Next
Set rng = rng.NextStoryRange
Loop
Next
If WithinPara Then
Print #FileNum, "</p>";
withpara = False
End If
Print #FileNum, vbCr & vbLf & "</body></html>"
Close FileNum
End Sub
Function CheckPara(ByRef NumPendingCR As Long, _
ByRef WithinPara As Boolean) As String
' Have a character to output. Check paragraph status, return
' necessary commands and adjust NumPendingCR and WithinPara.
Dim RtnValue As String
RtnValue = ""
If NumPendingCR = 0 Then
If Not WithinPara Then
CheckPara = "<p>"
WithinPara = True
Else
CheckPara = ""
End If
Exit Function
End If
If WithinPara And (NumPendingCR > 0) Then
' Terminate paragraph
RtnValue = "</p>"
NumPendingCR = NumPendingCR - 1
WithinPara = False
End If
Do While NumPendingCR > 1
' Replace each pair of CRs with an empty paragraph
RtnValue = RtnValue & "<p></p>"
NumPendingCR = NumPendingCR - 2
Loop
RtnValue = RtnValue & vbCr & vbLf & "<p>"
WithinPara = True
NumPendingCR = 0
CheckPara = RtnValue
End Function
