Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Sub Macrou()
- Dim ReadData As String
- Dim line As String
- Dim aString As String
- Dim bString As String
- Dim sizeString As String
- Dim hyperString As String
- Dim linkString As String
- Dim faceString As String
- Dim faceTypeString As String
- Dim pos1 As Integer
- Dim pos2 As Integer
- Dim pos3 As Integer
- Dim pos4 As Integer
- Dim i As Integer
- Dim j As Integer
- Dim tablesAdded As Boolean
- Dim colorString As String
- Open "E:\office.html" For Input As #1
- Do Until EOF(1)
- Line Input #1, ReadData
- pos1 = InStr(ReadData, "<")
- pos2 = InStr(ReadData, ">")
- pos3 = InStr(ReadData, "</")
- aString = Mid(ReadData, (pos1 + 1), (pos2 - pos1 - 1))
- pos4 = Len(aString)
- 'Selection.TypeText (ReadData)
- Selection.Font.Size = 12
- Selection.Font.Name = "Times New Roman"
- Selection.Font.Bold = False
- Selection.Font.Italic = False
- Selection.Font.ColorIndex = wdBlack
- If StrComp(aString, "b") = 0 Then
- Selection.Font.Bold = True
- Selection.Font.ColorIndex = wdBlack
- bString = Mid(ReadData, (pos1 + 3), (pos3 - pos1 - 3))
- Selection.TypeText (bString)
- Selection.TypeParagraph
- End If
- If StrComp(aString, "i") = 0 Then
- Selection.Font.Bold = False
- Selection.Font.Italic = True
- Selection.Font.ColorIndex = wdBlack
- bString = Mid(ReadData, (pos1 + 3), (pos3 - pos1 - 3))
- Selection.TypeText (bString)
- Selection.TypeParagraph
- End If
- If StrComp(Left(aString, 4), "font") = 0 Then
- colorString = Mid(aString, (pos1 + 13), (pos4 - pos1 - 13))
- sizeString = Mid(aString, (pos1 + 12), (pos4 - pos1 - 12))
- faceString = Mid(aString, (pos1 + 5), (pos1 + 3))
- faceTypeString = Mid(aString, (pos1 + 11), (pos4 - pos1 - 11))
- If StrComp(colorString, "red") = 0 Then
- Selection.Font.ColorIndex = wdRed
- Selection.TypeText (Mid(ReadData, (pos4 + 3), (pos3 - pos4 - 3)))
- Selection.TypeParagraph
- End If
- If StrComp(colorString, "yellow") = 0 Then
- Selection.Font.ColorIndex = wdYellow
- Selection.TypeText (Mid(ReadData, (pos4 + 3), (pos3 - pos4 - 3)))
- Selection.TypeParagraph
- End If
- If StrComp(colorString, "blue") = 0 Then
- Selection.Font.ColorIndex = wdBlue
- Selection.TypeText (Mid(ReadData, (pos4 + 3), (pos3 - pos4 - 3)))
- Selection.TypeParagraph
- End If
- If IsNumeric(sizeString) Then
- Selection.Font.Size = sizeString
- Selection.TypeText (Mid(ReadData, (pos4 + 3), (pos3 - pos4 - 3)))
- Selection.TypeParagraph
- End If
- If StrComp(faceString, "face") = 0 Then
- Selection.Font.Name = faceTypeString
- Selection.TypeText (Mid(ReadData, (pos4 + 3), (pos3 - pos4 - 3)))
- Selection.TypeParagraph
- End If
- Selection.ClearFormatting
- End If
- If StrComp(aString, "ul") = 0 Then
- Selection.Font.Bold = False
- Selection.Font.Italic = False
- Dim listItem As String
- Selection.Range.ListFormat.ApplyBulletDefault
- Do Until InStr(line, "</ul>") > 0
- Line Input #1, line
- If StrComp(line, "</ul>") <> 0 Then
- pos1 = InStr(line, "<")
- pos2 = InStr(line, "</")
- listItem = Mid(line, (pos1 + 4), (pos2 - pos1 - 4))
- 'MsgBox listItem
- Selection.TypeText (listItem)
- Selection.TypeParagraph
- End If
- Loop
- 'Selection.Range.ParagraphFormat.Reset
- Selection.ClearFormatting
- 'MsgBox aString
- 'Selection.TypeText (bString)
- Selection.TypeParagraph
- End If
- If StrComp(aString, "ol") = 0 Then
- Selection.Font.Bold = False
- Selection.Font.Italic = False
- Selection.Range.ListFormat.ApplyNumberDefault
- Do Until InStr(line, "</ol>") > 0
- Line Input #1, line
- If StrComp(line, "</ol>") <> 0 Then
- pos1 = InStr(line, "<")
- pos2 = InStr(line, "</")
- listItem = Mid(line, (pos1 + 4), (pos2 - pos1 - 4))
- 'MsgBox listItem
- Selection.TypeText (listItem)
- Selection.TypeParagraph
- End If
- Loop
- Selection.ClearFormatting
- 'MsgBox aString
- 'Selection.TypeText (bString)
- Selection.TypeParagraph
- End If
- If StrComp(aString, "table") = 0 Then
- Selection.Font.Bold = False
- Selection.Font.Italic = False
- Dim trString As String
- Dim tdItem As String
- Dim line2 As String
- Dim pos5 As Integer
- Dim pos6 As Integer
- Dim nrRows As Integer
- Dim nrCols As Integer
- nrRows = 0
- nrCols = 0
- line = "<table>"
- Do Until InStr(line, "</table>") > 0
- Line Input #1, line
- If StrComp(line, "</table>") <> 0 Then
- pos5 = InStr(line, "<")
- pos6 = InStr(line, ">")
- trString = Mid(line, (pos5 + 1), (pos6 - pos5 - 1))
- 'MsgBox trString
- If StrComp(trString, "tr") = 0 Then
- nrRows = nrRows + 1
- nrCols = 0
- line2 = ""
- Do Until (InStr(line2, "</tr>") > 0)
- Line Input #1, line2
- If ((StrComp(line2, "</tr>") <> 0) And (InStr(line2, "</tr>") <= 0)) Then
- pos1 = InStr(line2, "<")
- pos2 = InStr(line2, "</")
- nrCols = nrCols + 1
- tdItem = Mid(line2, (pos1 + 4), (pos2 - pos1 - 4))
- End If
- Loop
- End If
- End If
- Loop
- End If
- If StrComp(Left(aString, 6), "a href") = 0 Then
- hyperString = Mid(aString, (pos1 + 8), (pos4 - pos1 - 8))
- linkString = Mid(ReadData, (pos4 + 3), (pos3 - pos4 - 3))
- Selection.Hyperlinks.Add Anchor:=Selection.Range, _
- Address:=hyperString, TextToDisplay:=linkString
- End If
- Loop
- Close #1
- Open "E:\office.html" For Input As #2
- If StrComp(aString, "table") = 0 Then
- Selection.Font.Bold = False
- Selection.Font.Italic = False
- Dim tblNew As Table
- Set tblNew = Selection.Tables.Add(Selection.Range, nrRows, nrCols)
- nrRows = 0
- nrCols = 0
- line = "<table>"
- Do Until InStr(line, "</table>") > 0
- Line Input #2, line
- If StrComp(line, "</table>") <> 0 Then
- pos5 = InStr(line, "<")
- pos6 = InStr(line, ">")
- trString = Mid(line, (pos5 + 1), (pos6 - pos5 - 1))
- 'MsgBox trString
- If StrComp(trString, "tr") = 0 Then
- nrRows = nrRows + 1
- nrCols = 0
- line2 = ""
- Do Until (InStr(line2, "</tr>") > 0)
- Line Input #2, line2
- If ((StrComp(line2, "</tr>") <> 0) And (InStr(line2, "</tr>") <= 0)) Then
- pos1 = InStr(line2, "<")
- pos2 = InStr(line2, "</")
- nrCols = nrCols + 1
- tdItem = Mid(line2, (pos1 + 4), (pos2 - pos1 - 4))
- Selection.Tables.Item(1).Cell(nrRows, nrCols).Range.Text = tdItem
- End If
- Loop
- End If
- End If
- Loop
- End If
- Close #2
- End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement