Count number of bullets in Active word Documents VBA - vba

I am using this code to count number of bullets in word documents. But its always returning zero.
Sub FindBullet()
Dim oPara As Word.Paragraph
Dim count As Integer
count = 0
'Select Entire document
Selection.WholeStory
With Selection
For Each oPara In .Paragraphs
If oPara.Range.ListFormat.ListType = WdListType.wdListBullet Then
count = count + 1
End If
Next
End With
'Gives the count of bullets in a document
MsgBox count
End Sub

Well, I just opened up a blank Word doc, popped the code in and ran it, and it is returning however many bullets I put in. I did not modify your code...
Could your bullets really be something else, like a numbered list or some other symbol?

Related

VBA - Word change the concept of word(a.b is one word or two)

I have a question: i want to have an array of words of a WORD document, which are larger than 29 and Shorter than 40 characters. I implemented it in VBA this way:
Sub function()
Dim arr(1000) As String
counter = 0
For Each sentence In ActiveDocument.StoryRanges
For Each w In sentence.Words
If Len(w) > 28 And Len(w) < 40 Then
arr(counter) = w
counter = counter + 1
End If
Next
Next
End Sub
The Problem is that I want all words with char '_' cosidered as one word; for example: 'Adrian_link_mart' is one word and not 3: 'Adrian' and 'link' and 'mart' like it will be considered
thanks for your help, adrian
This may help. There is a bit of a wrinkle as you will see below.
Option explicit
Sub test()
' Use a collection rather than an array as we don't need
' to know the size in advance
Dim word_array As Collection
' Word doesn't actually have a 'word' object. Probably because
' that clashes with Word the application. So instead of Word.Word
' we are using word.range which gives us all the utility we will
' need
Dim my_word_range As Word.Range
Dim my_range As Word.Range
For Each my_range In ActiveDocument.StoryRanges
For Each my_word_range In my_range.Words
With my_word_range
Do While .Next(unit:=wdCharacter) = "_"
' '_' is considered to be a word by Word so we need to
' count two Word words to get to the end of the next
' text word IYSWIM
.MoveEnd unit:=wdWord, Count:=2
Loop
If .Characters.Count > 28 And .Characters.Count < 40 Then
word_array.Add Item:=.Text
End If
End With
Next
Next
End Sub
If you are new to VBA then
Include Option explicit at the top of every module
In the VBA IDE go Tools.Option.Editor.Code Settings and make sure every box is ticked.
Learn how to use F1. In the VBA IDE, putting the cursor on a keyword and pressing F1 will bring up the MS help page for that keyword

VBA WORD Identify if paragraph is a list or table

I have the following code:
For Each DocPara In ActiveDocument.Paragraphs
If (DocPara.style = "Title 1") Then
...
Else
(if DocPara is LIST then)
...
(else if DocPara is TABLE then)
...
End If
Next DocPara
So, I would need to know if the current paragraph is or not a LIST and a TABLE.
Thank You.
You can test whether a paragraph range is in a table by getting the table count: if it's greater than zero (Range.Tables.Count > 0) then the range is in a table. There's also the older, WordBasic method: Range.Information(wdWIthinTable) = true.
For determining whether a range is part of a list (whether bullets or numbering) you can use Range.ListFormat.ListType. This returns a member of the WdListType enumeration. wdListNoNumbering is 0 - you can use either value. The other members of the enumeration can tell you whether it's bullets (and what kind) or numbers (what kind of list) if that information is of use.
I've changed the order for checking lists and tables, putting tables first on the assumption you need to know that primarily. (Checking for a list will then not happen.)
Sub CheckParaType()
Dim DocPara As Word.Paragraph
Dim rngPara As Word.Range
For Each DocPara In ActiveDocument.paragraphs
Set rngPara = DocPara.Range
If (DocPara.style = "Title") Then
Debug.Print "Style is OK"
ElseIf rngPara.Tables.Count > 0 Then
Debug.Print "It's in a table"
ElseIf rngPara.ListFormat.ListType <> 0 Then
Debug.Print "It's a list."
Else
Debug.Print "the paragraph is something else"
End If
Next DocPara
End Sub

Determine Bullet List Style Using Word VBA

I am currently trying to parse through a Word document which is full of bullet lists. I am able to iterate over and count all bullets in the document (see below), but I can't seem to find any way to determine what bullet style is being used for each bullet. All these bullets exist on the same level, so the list level doesn't help. I need to be able to determine "Is this bullet an Arrow icon or a Black dot icon?" However, since the styles are the defaults baked into Word I can see a way to SET the style for that list, but I can't find a way to GET a value of the current style.
Thanks in advance for your help!
Dim oPara As Word.Paragraph
Dim count As Integer
count = 0
'Select Entire document
Selection.WholeStory
With Selection
For Each oPara In .Paragraphs
If oPara.Range.ListFormat.ListType = WdListType.wdListBullet Then
MsgBox "debug: " & oPara.Range.ListFormat.ListType & "//" & oPara.Range.Text
count = count + 1
End If
Next
End With
'Gives the count of bullets in a document
MsgBox count

How to write VBA to format sentence starting with // in Word 2016?

I have a 400+ page coding manual I use, and unfortunately turned off the green for all the comments in the manual. I can't undo it, as I hadn't noticed it until it was too late. Its ruined years of work.
How would I write VBA to parse the document finding sentences starting with // and ending in a Paragraph mark and change the color of them? Or assign a style to them?
Here is a start that I have cobbled together, I admire people who can write code without intellisence, its like trying to find your way blindfolded
Dim oPara As Word.Paragraph
Dim rng As Range
Dim text As String
For Each oPara In ActiveDocument.Paragraphs
If Len(oPara.Range.text) > 1 Then
Set rng = ActiveDocument.Range(oPara.Range.Start,oPara.Range.End)
With rng.Font
.Font.Color = wdColorBlue
End With
End If
Next
End Sub
The following seems to work:
Dim oPara As Word.Paragraph
Dim text As String
For Each oPara In ActiveDocument.Paragraphs
text = oPara.Range.text
'Check the left 2 characters for //
If Left(oPara.Range.text, 2) = "//" Then
oPara.Range.text = "'" & text
End If
Next
I assume you are using VBA so by placing a ' in front of // it will turn the line green. You could modify the code to replace // with ' if desired. The opera.range.text should grab the entire paragraph.

better method for accenting every word in Word document?

I am new to programming, but I am trying to adapt an existing script as a MS Word 2010/2013 addin to add correct stress accentuation to every Latin word in an open document.
The script "DoAccentuate" returns an accented word for any unaccented Latin word I send it as a string. I just need help doing a better job of looping through all the words, and then stopping the loop when the last word is reached. My current method is a bit goofy...I insert a nonesense word at the end of the document and then loop until it gets selected and accented.
Perhaps there's a better or more efficient way to go about the whole thing.
Public Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click
Dim document As Word.Document
document = Globals.ThisAddIn.Application.ActiveDocument
Dim mySelection = document.Application.Selection
'make sure cursor is at start of document
document.Application.Selection.HomeKey(Unit:=Microsoft.Office.Interop.Word.WdUnits.wdStory)
'insert fake word at end to stop the loop
Dim range As Word.Range
range = document.Range()
range.InsertAfter(" documentendatoris")
Do
'use MS Word's wildcard to select the first individual word as trimmed string
mySelection.Find.Text = "<*>"
mySelection.Find.MatchWildcards = True
mySelection.Find.Execute()
'replace the selected word that has been found with its accented counterpart
mySelection.Text = Accentuate.Accentuate.DoAccentuate(mySelection.Text)
Loop Until mySelection.Text = "documentendatóris"
End Sub
Well, I don't realy know if its more efficient way but you could use document.Content and range.Words collection to check all words in main story range
document = Globals.ThisAddIn.Application.ActiveDocument
Dim range As Word.Range
range = document.Content
Dim current As Integer
current = 0
Dim words As Word.Words
words = range.Words
Dim word As Word.Range
Do
current = current + 1
If current < words.Count Then
word = words(current)
If word.Text.EndsWith(" ") Then
word.Text = word.Text.Trim() + "'s "
'replace the selected word that has been found with its accented counterpart
'mySelection.Text = Accentuate.Accentuate.DoAccentuate(mySelection.Text)
Else
word.Text = word.Text.Trim() + "'s"
End If
End If
Loop Until current = words.Count