|
I've also made a few quick macros to sort out text.
The first is intended to format text as italic when it has been formatted using underscores (ie: this is _italic_ text) - lots of text files seem to use this. Note that if there are an uneven number of underscores you'll get interesting results...
The second macro is to fix text that has extraneous carriage returns in it, as often happens, like this:
"this is one line of
text
but somehow we have a new carriage return in it..."
Note that you must first ensure you have edited the macro to indicate how many carriage returns are in the text (sometimes it will be two, but usually it's one).
Both macros are quick hacks, and can benefit from some tweaking, but work fine for my purposes. Here they are:
Sub FixBadText()
' THIS MACRO WILL REPLACE EXTRA LINE BREAKS IN TEXT WITH A SPACE
Dim sReplaceParas As String
' NOTE: change the value in the double quotes below to ^13^13 if there are two
' carriage returns in the document
sReplaceParas = "^13"
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
' need to use wildcards here
.Text = "[A-z]" & sReplaceParas & "[A-z]" ' ^13 is paragraph char
.Forward = True
.Wrap = wdFindContinue 'wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True 'False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Replacement.Text = ""
End With
While Selection.Find.Execute
'Do something within the found text
' here i need to replace just the middle chars, ie the paragraph marks
Selection.TypeText (Selection.Characters.First & " " & Selection.Characters.Last)
Wend
'Now do the same but for commas!
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
' need to use wildcards here
.Text = "," & sReplaceParas & "[A-z]" ' ^13 is paragraph char
.Forward = True
.Wrap = wdFindContinue 'wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True 'False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Replacement.Text = ""
End With
While Selection.Find.Execute
'Do something within the found text
' here i need to replace just the middle chars, ie the paragraph marks
'MsgBox "Value found: " & Selection.Characters.First & Selection.Characters.Last, vbCritical
Selection.TypeText (Selection.Characters.First & " " & Selection.Characters.Last)
Wend
'Now do the same but for hyphens!
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
' need to use wildcards here
.Text = "-" & sReplaceParas & "[A-z]" ' ^13 is paragraph char
.Forward = True
.Wrap = wdFindContinue 'wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True 'False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Replacement.Text = ""
End With
While Selection.Find.Execute
'Do something within the found text
' here i need to replace just the middle chars, ie the paragraph marks
'MsgBox "Value found: " & Selection.Characters.First & Selection.Characters.Last, vbCritical
Selection.TypeText (Selection.Characters.First & " " & Selection.Characters.Last)
Wend
End Sub
---------------------------------------------------
Sub ChangeToItalics()
' THIS WILL REPLACE _some text_ into italics
' Note: if there is an uneven number of underscores, you will encounter problems!
Dim iBookMark As Integer
Dim lStart As Long
Dim lEnd As Long
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
' Need to use wildcards here
.Text = "_"
.Forward = True
.Wrap = wdFindContinue 'wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Replacement.Text = ""
End With
iBookMark = 0
While Selection.Find.Execute
' Here we replace the underscores with blank string, and ensure any text between
' them is formatted as italic
ActiveDocument.Bookmarks.Add "temp" & iBookMark
'Selection.MoveRight
Selection.MoveUntil "_"
ActiveDocument.Bookmarks.Add "temp" & (iBookMark + 1)
' Note that first char in story is 0, not 1...
lStart = ActiveDocument.Bookmarks("temp0").Start
lEnd = ActiveDocument.Bookmarks("temp1").Start
' Now make the first bookmark select the whole text between the two underscores
ActiveDocument.Bookmarks("temp0").Start = lStart + 1
ActiveDocument.Bookmarks("temp0").End = lEnd
' Now select the bookmark text
ActiveDocument.Bookmarks("temp0").Select
' And make it italic
Selection.ItalicRun
' Now delete the underscores
ActiveDocument.Bookmarks("temp0").Select
Selection.MoveLeft wdCharacter, 2
Selection.Delete
ActiveDocument.Bookmarks("temp1").Select
Selection.Delete
Wend
' Delete the bookmarks we created
Dim iCount As Integer
iCount = 0
Do While iCount <= 2
If ActiveDocument.Bookmarks.Exists("temp" & iCount) = True Then
ActiveDocument.Bookmarks("temp" & iCount).Delete
End If
iCount = iCount + 1
Loop
End Sub
|