PDA

View Full Version : [SOLVED:] Using VBA to put in HTML tags for bolded, italicized or underlined text


Pat Parker
11-04-2016, 12:53 PM
Hi all. I am a novice at VBA who learns by looking at existing VBA code and making small changes to it until I figure out what I need to do. However, I am at an impasse here. I have a problem where I am trying to use VBA code I found online to go through a word doc and put HTML type tags for anything that is bold, underlined, or italic. The problem is that the code has a problem with the outline format of my word doc (see attached with the macro A_Add_HTML_tags contained in it). For example, if you run the macro, the outline section (iii) appears as follows:

Capital structure<i><b>

I want it to appear as follows:
<b><i>Capital structure<i><b>

The other tags that I need are at the end of the preceding line, which doesn't help me. I tried changing .MatchWholeWord to True which somewhat accomplishes what I need, but then every single word has tags. Any advice would be greatly appreciated. VBA code is pasted below:


Sub A_Add_HTML_tags() ' 1102/16 - should add HTML tags to all word docs in the folder
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document
' strFolder = GetFolder
' strFolder = "C:\" ' I added this to override the above line
' If strFolder = "" Then Exit Sub
'strFile = Dir(strFolder & "\*.doc", vbNormal)
' While strFile <> ""
' Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
With ActiveDocument.Range.Find
.Text = ""
.Forward = True
' .Wrap = wdFindStop ' this is from the bold tag macro
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False


.ClearFormatting
.Font.Bold = True
.Font.Italic = True
With .Replacement
.ClearFormatting
.Text = "<b><i>^&<i></b>"
.Font.Bold = False
.Font.Italic = False
End With
.Execute Replace:=wdReplaceAll



.ClearFormatting
.Font.Bold = True
With .Replacement
.ClearFormatting
.Text = "<b>^&</b>"
.Font.Bold = False
End With
.Execute Replace:=wdReplaceAll
.ClearFormatting
.Font.Italic = True
With .Replacement
.ClearFormatting
.Text = "<i>^&<i>"
.Font.Italic = False
End With
.Execute Replace:=wdReplaceAll
.ClearFormatting
.Font.Underline = True
With .Replacement
.ClearFormatting
.Text = "<u>^&<u>"
.Font.Underline = False
End With
.Execute Replace:=wdReplaceAll
End With
' wdDoc.Close SaveChanges:=True
' strFile = Dir()
' Wend
' Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub
SamT
11-05-2016, 08:41 AM
I don't code for Word, but this post will bump your thread back to the top.

If I did, I would start by defining Constants for the various tags

Const ItalicsStart as String = "<i>"
Const ItalicsEnd as String = "</i>"
Const StartB as String = "<b>"
Const BEnd As String = "</b>"
Const StartB_I As String = StartB & ItalicsStart

Is this line is supposed to replace some string or another with the "^&"? That just doesn't look right to me, but it is what you have.

.Text = "<b><i>^&<i></b>"
I think it should be used as

.Text = "<b><i>" ^& "<i></b>"
'OR
.Text = StartB_I ^& EndB_I
Being as I don't know Word, Just what I see you using, try this

.Text = "<b><i>" & .Replacement & "<i></b>"
gmaxey
11-05-2016, 11:59 AM
Something like this perhaps:


Sub TagAndClearFormating()
Dim oRng As Word.Range
Dim arrTagPairs() As String, arrTags() As String
Dim lngIndex As Long
arrTagPairs = Split("<i><b>*</i></b>|<i>*</i>|<b>*</b>|<u>*</u>", "|")
For lngIndex = 0 To UBound(arrTagPairs)
arrTags = Split(arrTagPairs(lngIndex), "*")
Set oRng = ActiveDocument.Range
With oRng.Find
.ClearFormatting
If InStr(arrTags(0), "b") > 0 Then .Font.Bold = True
If InStr(arrTags(0), "i") > 0 Then .Font.Italic = True
If InStr(arrTags(0), "u") > 0 Then .Font.Underline = True
While .Execute
With oRng
If InStr(arrTags(0), "b") > 0 Then .Font.Bold = False
If InStr(arrTags(0), "i") > 0 Then .Font.Italic = False
If InStr(arrTags(0), "u") > 0 Then .Font.Underline = False
If .Characters.Last = vbCr Then .End = .End - 1
.Text = arrTags(0) & .Text & arrTags(1)
.Collapse wdCollapseEnd
End With
Wend
End With
Next lngIndex
End Sub
gmaxey
11-05-2016, 12:07 PM
Something like this perhaps:


Sub TagAndClearFormating()
Dim oRng As Word.Range
Dim arrTagPairs() As String, arrTags() As String
Dim lngIndex As Long
arrTagPairs = Split("<i><b>*</i></b>|<i>*</i>|<b>*</b>|<u>*</u>", "|")
For lngIndex = 0 To UBound(arrTagPairs)
arrTags = Split(arrTagPairs(lngIndex), "*")
Set oRng = ActiveDocument.Range
With oRng.Find
.ClearFormatting
If InStr(arrTags(0), "b") > 0 Then .Font.Bold = True
If InStr(arrTags(0), "i") > 0 Then .Font.Italic = True
If InStr(arrTags(0), "u") > 0 Then .Font.Underline = True
While .Execute
With oRng
If InStr(arrTags(0), "b") > 0 Then .Font.Bold = False
If InStr(arrTags(0), "i") > 0 Then .Font.Italic = False
If InStr(arrTags(0), "u") > 0 Then .Font.Underline = False
If .Characters.Last = vbCr Then .End = .End - 1
.Text = arrTags(0) & .Text & arrTags(1)
.Collapse wdCollapseEnd
End With
Wend
End With
Next lngIndex
Sub TagAndClearFormating()
Dim oRng As Word.Range
Dim arrTagPairs() As String, arrTags() As String
Dim arrChars() As String, arrEntities() As String
Dim lngIndex As Long
arrTagPairs = Split("<i><b>*</i></b>|<i>*</i>|<b>*</b>|<u>*</u>", "|")
For lngIndex = 0 To UBound(arrTagPairs)
arrTags = Split(arrTagPairs(lngIndex), "*")
Set oRng = ActiveDocument.Range
With oRng.Find
.ClearFormatting
If InStr(arrTags(0), "b") > 0 Then .Font.Bold = True
If InStr(arrTags(0), "i") > 0 Then .Font.Italic = True
If InStr(arrTags(0), "u") > 0 Then .Font.Underline = True
While .Execute
With oRng
If InStr(arrTags(0), "b") > 0 Then .Font.Bold = False
If InStr(arrTags(0), "i") > 0 Then .Font.Italic = False
If InStr(arrTags(0), "u") > 0 Then .Font.Underline = False
If .Characters.Last = vbCr Then .End = .End - 1
.Text = arrTags(0) & .Text & arrTags(1)
.Collapse wdCollapseEnd
End With
Wend
End With
Next lngIndex
arrChars = Split("38|34|39|145|146|147|148|162", "|")
arrEntities = Split("&|"|'|'|'|&|&|¢", "|")
For lngIndex = 0 To UBound(arrChars)
Set oRng = ActiveDocument.Range
With oRng.Find
.ClearFormatting
.Text = Chr(arrChars(lngIndex))
.Replacement.Text = arrEntities(lngIndex)
.Execute Replace:=wdReplaceAll
End With
Next lngIndex
End Sub


End Sub
Pat Parker
11-05-2016, 02:32 PM
Something like this perhaps:


Sub TagAndClearFormating()
Dim oRng As Word.Range
Dim arrTagPairs() As String, arrTags() As String
Dim arrChars() As String, arrEntities() As String
Dim lngIndex As Long
arrTagPairs = Split("<i><b>*</i></b>|<i>*</i>|<b>*</b>|<u>*</u>", "|")
For lngIndex = 0 To UBound(arrTagPairs)
arrTags = Split(arrTagPairs(lngIndex), "*")
Set oRng = ActiveDocument.Range
With oRng.Find
.ClearFormatting
If InStr(arrTags(0), "b") > 0 Then .Font.Bold = True
If InStr(arrTags(0), "i") > 0 Then .Font.Italic = True
If InStr(arrTags(0), "u") > 0 Then .Font.Underline = True
While .Execute
With oRng
If InStr(arrTags(0), "b") > 0 Then .Font.Bold = False
If InStr(arrTags(0), "i") > 0 Then .Font.Italic = False
If InStr(arrTags(0), "u") > 0 Then .Font.Underline = False
If .Characters.Last = vbCr Then .End = .End - 1
.Text = arrTags(0) & .Text & arrTags(1)
.Collapse wdCollapseEnd
End With
Wend
End With
Next lngIndex
arrChars = Split("38|34|39|145|146|147|148|162", "|")
arrEntities = Split("&|"|'|'|'|&|&|¢", "|")
For lngIndex = 0 To UBound(arrChars)
Set oRng = ActiveDocument.Range
With oRng.Find
.ClearFormatting
.Text = Chr(arrChars(lngIndex))
.Replacement.Text = arrEntities(lngIndex)
.Execute Replace:=wdReplaceAll
End With
Next lngIndex
End Sub





Greg - I can't thank you enough for doing this. You did a lot more than just point out my problems - you wrote the code to accomplish the task. This macro works fantastically and is exactly what I needed. I just checked out your personal site and see you are a Navy vet - my father-in-law is also a Navy vet and I have 2 nephews presently serving in the Navy (chocks and locks). I made a small donation through your site and I truly appreciate you doing this for me. You are a good egg.
Pat Parker
11-05-2016, 02:39 PM
Sam, thank you for taking the time to answer. I tried your suggestions but kept receiving syntax errors. However, Greg's solution works splendidly. Thanks again for helping me out!
gmaxey
11-05-2016, 03:05 PM
Thank you. Glad to help.