View Single Post
 
Old 02-01-2019, 03:36 AM
mroatman mroatman is offline Mac OS X Office 2019
Novice
 
Join Date: Jan 2019
Location: Tallinn, Estonia
Posts: 9
mroatman is on a distinguished road
Default

As I continued to play around, I was able to achieve what I was looking for. It seems the key was to un-automate the bullet lists via:

ActiveDocument.ConvertNumbersToText

My final input is probably the messiest code on the planet, and I'm sure there are numerous ways to simplify what I have done. But it finally works. So for posterity, in case it's ever helpful to someone else in the future, I will post it below.

Quote:

Sub TopiaFormat()
'
' TopiaFormat Macro
'

ActiveDocument.ConvertNumbersToText

Dim Para As Paragraph, Rng As Range
For Each Para In ActiveDocument.Range.Paragraphs
With Para.Range
If .Text Like "?" & vbTab & "*" Then
Set Rng = .Duplicate
With Rng
.End = .Start + 2
.Text = vbNullString
.InsertBefore Chr(149) & vbTab
End With
End If
End With
Next

With Selection.Find
.ClearFormatting
.Text = "^0233"
.Replacement.ClearFormatting
.Replacement.Text = " - "
.Execute Replace:=wdReplaceAll, Forward:=True, _
Wrap:=wdFindContinue
End With

With Selection.Find
.ClearFormatting
.Text = "ï"
.Replacement.ClearFormatting
.Replacement.Text = "[*]"
.Execute Replace:=wdReplaceAll, Forward:=True, _
Wrap:=wdFindContinue
End With

With Selection.Find
.ClearFormatting
.Text = "[*]^w"
.Replacement.ClearFormatting
.Replacement.Text = "[*]"
.Execute Replace:=wdReplaceAll, Forward:=True, _
Wrap:=wdFindContinue
End With

With Selection.Find
.Text = "^p^p"
.Replacement.Text = "^p^p^p"
.Execute Replace:=wdReplaceAll, Forward:=True, _
Wrap:=wdFindContinue
End With

Dim HLnk As Hyperlink
For Each HLnk In ActiveDocument.Hyperlinks
HLnk.Range.InsertAfter "]"
Next

For Each HLnk In ActiveDocument.Hyperlinks
HLnk.Range.InsertBefore "[>" & HLnk.Address & "|"
Next

Dim oField As Field
For Each oField In ActiveDocument.Fields
If oField.Type = wdFieldHyperlink Then
oField.Unlink
End If
Next
Set oField = Nothing

ActiveDocument.Select
Selection.ClearFormatting

End Sub
Reply With Quote