A Restless Mind

I created this VBA macro so that I could insert paragraph returns at suitable places in a doc in order that each line was no more than 80 characters (so that when I send it to bloomberg it formats properly).

Sub ShortLines()
‘
‘ Author rrheaume
‘
LineLength = 80 ‘change as required
BiggestWord = 25 ‘change as required

Limit = ActiveDocument.Characters.Count * 1.2 ‘ just incase something goes wrong!

Selection.HomeKey Unit:=wdStory

‘ clean the text up a bit and ID tabs which will be replaced with 4 spaces (ggg)

With Selection.Find
.Text = “^p”
.Replacement.Text = “^p^p”
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

With Selection.Find
.Text = “^p^t”
.Replacement.Text = “^pgggg ”
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

With Selection.Find
.Text = “^t”
.Replacement.Text = ” || ”
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

For Loops = 1 To ActiveDocument.Characters.Count / 40

‘ reset counters

RightMover = 0
SkipOver = 0
LeftMover = 0

‘ Move right until you get to a paragraph return or a count of 80
‘ If you get to a paragraph return skip over the next step and start over

For x = 1 To LineLength
If RightMover < LineLength Then
Selection.MoveRight Unit:=wdCharacter, Count:=1
RightMover = RightMover + 1
BigCounter = BigCounter + 1
If BigCounter > Limit Then Exit Sub
If Selection.Text = Chr(13) Then
SkipOver = 1
RightMover = LineLength + 1
End If
End If
Next x

‘ move left until you find a space character then insert a paragraph mark

If SkipOver = 0 Then
For Y = 1 To BiggestWord
If LeftMover < BiggestWord + 1 Then
Selection.MoveRight Unit:=wdCharacter, Count:=-1
If Selection.Text = Chr(13) Then LeftMover = BiggestWord + 1
If Selection.Text = " " Then
Selection.TypeParagraph
LeftMover = BiggestWord + 1
End If
LeftMover = LeftMover + 1
End If
Next Y

End If

Next Loops

' the rest just cleans up the text a bit

With Selection.Find
.Text = "^p "
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll

With Selection.Find
.Text = " ^p"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll

For Y = 1 To 10
With Selection.Find
.Text = "^p^p^p"
.Replacement.Text = "^p^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll

Next Y

Selection.WholeStory
With Selection.ParagraphFormat
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
.LineUnitBefore = 0
.LineUnitAfter = 0
End With
Selection.HomeKey Unit:=wdStory

' then we go back in an find the tab marker (gggg) and replace it with spaces

With Selection.Find
.Text = "^pgggg"
.Replacement.Text = "^p "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

With Selection.Find
.Text = "||"
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

With Selection.Find
.Text = " "
.Replacement.Text = " "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute Replace:=wdReplaceAll

End Sub

Categories: projects, tech
Tags: bloomberg, macro, program, programming, vba, word