List Bullet end punctuation macro (tidy up)

J

James

Hello,

I wonder if someone could help me please? - Im hoping this should be
fairly easy to anyone adept at Word VBA. I have put together this
untidy Macro and would like to make it more efficient and compact if
poss - but I dont know how as this is on the limit of my ability
really.

My goal is to get the macro to search for List Bullets, delete any
trailing spaces, delete common punctuation at end of bullet and add a
period to the end of the last bullet in the list (which it does not do
yet).

I would like this to happen one bullet at a time (per button click) so
I can check that having no punctuation is suitable.

If someone could help me with this I would be most grateful :)

Thanks

James


Public Sub bulletpunctuation()

Dim myRange As Word.Range
Dim mystring As String
Dim rngTarget As Word.Range
Dim oPara As Word.Paragraph
Dim yPara As Word.Range

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

'Look for bullets and move to end
Set rngTarget = Selection.Range
With rngTarget
Call .Collapse(wdCollapseEnd)
.End = ActiveDocument.Range.End
For Each oPara In .Paragraphs
If oPara.Range.ListFormat.ListType =
WdListType.wdListBullet Then
Set yPara = oPara.Range
yPara.Move wdParagraph
yPara.End = yPara.End - 2
yPara.MoveEnd wdCharacter, 2
yPara.Select

'replace end punctuation
Set myRange = yPara
With myRange.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ";"
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
End With
Set myRange = yPara
With myRange.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ":"
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
End With
Set myRange = yPara
With myRange.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ","
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
End With
Set myRange = yPara
With myRange.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "."
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
End With
yPara.Move wdParagraph, 1
Exit For
End If
Next
End With
End Sub
 
H

Helmut Weber

Hi James,

do you want the macro to process the selection only
or the whole doc?

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"
 
J

James

Hi Helmut,

I would like it to run through the whole doc ideally - to ensure that
all bulleted lists are the same. Preferably from where ever the cursor
is and not from the start of the doc - a bit like spellcheck.

Thanks

James
 
H

Helmut Weber

Hi James,

ok, one step after the other.

Sub PurgeParagraphEnd()
Dim oPrg As Paragraph
For Each oPrg In ActiveDocument.Paragraphs
With oPrg.Range.Find
.Text = "^w^p"
.Replacement.Text = "^p"
.Execute Replace:=wdReplaceAll
End With
Next
End Sub

Alright, if that works for you.
Though, there may be autocorrect options,
which will lead to an endless loop.
To avoid this,
you would have to set
paragraph.range.characters.last.previous to "" :-(


Because of lack of testing material,
this is pseudo code, like:

for each lPrg in activedocument.listparagraphs
if lPrg.ListFormat.ListType = wdListBullet (?) then
select case lPRg.range.characters.last.previous
case ",", ";", "." etc
lPRg.range.characters.last.previous = ""
end select
endif
next

Nevertheless, HTH

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"
 
H

Helmut Weber

Hmm....

for PurgeParagraphEnd()
the former was not the optimum.

Sub PurgeParagraphEndX()
Dim rDcm As Range
Set rDcm = ActiveDocument.Range
With rDcm.Find
.Text = "^w^p"
.Replacement.Text = "^p"
.Execute Replace:=wdReplaceAll
End With
End Sub

--
Per aspera ad astra. 712,000 hits. ;-)

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"
 
H

Helmut Weber

Ha...

yes, looks so simple,
but adds an additional paragraph mark
at the end of the doc, in case,
the last paragraph mark was preceded by whitespace.

Can all be handeld, if it really has to be.

Public Sub DeleteDocEnd()
Dim s As String
With ActiveDocument
If Len(.Range) = 1 Then Exit Sub
s = .Characters.Last.Previous
While s = Chr(13)
.Characters.Last.Previous = ""
s = .Characters.Last.Previous
Wend
End With
End Sub
 
J

James

Hi Helmut,

I will try and have a proper look at these later if I have time and get
back to you.

Thanks :)

James
 
H

Helmut Weber

Hi James,

this has turned out to be a real brain twister.

A permanent change between readability and efficiency,
and a million ways to achieve the same goal.

Good luck.

Sub Test9000000()
Dim rDcm As Range
Dim rChr As Range
Set rDcm = ActiveDocument.Range(0, 0)
With rDcm.Find
.Text = "^p"
While .Execute
Set rChr = rDcm.Characters.First.Previous
Select Case Asc(rChr.Text)
Case 9, 32, 160
rChr.Text = ""
rDcm.Collapse
' thx Greg
End Select
Wend
End With
' ----------------------------------------------
Set rDcm = ActiveDocument.Range(0, 0)
With rDcm.Find
.Text = "^p"
While .Execute
If rDcm.ListFormat.ListType = wdListBullet Then
Set rChr = rDcm.Characters.Last.Previous
Select Case Asc(rChr.Text)
Case 44, 46, 58, 59
rChr.Text = ""
rDcm.Collapse
End Select
End If
Wend
End With
End Sub

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"
 
J

James

Ok, with my very limited knowledge that looks like a more compact
version of my original code so thanks.

How would I go about selecting the last bullet in a list so I can add a
period point to the end of it? The finding bit is the crux for me as I
should be able to work out the rest.

James
 
J

James

Ok, with my very limited knowledge that looks like a more compact
version of my original code so thanks.

How would I go about selecting the last bullet in a list so I can add a
period point to the end of it? The finding bit is the crux for me as I
should be able to work out the rest.

James
 
H

Helmut Weber

Hi James

I'm exhausted.

Try this:

Sub MakeSureThatThereIsAPeriodAtTheEndofLastListparagraph()
Dim lCnt As Long
lCnt = ActiveDocument.Range.ListParagraphs.Count
With ActiveDocument.Range.ListParagraphs(lCnt).Range
If .Characters.Last.Previous <> "." Then
.Characters.Last.InsertBefore Text:="."
End If
End With
End Sub

HTH

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"
 
J

James

Thats great! I have something to work with now. I will play around with
these bits and create a frankenstein monster type macro over the
weekend.

I will let you know how I get on next week.

Thanks for your help Helmut ...your MVP badge is justified :)

Have a great weekend.

James
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Word macro that can call cells out of Excel for a find and replace 0
Change a great number of words in word files, with a macro as short as possible. 5
CleanUpPastedText() 1
Match style 0
Word Macro for multiple searches, incl. in footnotes 2
Need help modifying code 0
VBA to look for more than 1 key word and highlights 8
Find/replace shading - should be simple 5

Top