I have the following function with which i want to apply a specific Style to all numbered elements in my word document:
Function SetNumberingStyle()
Dim para As Paragraph, i As Long
For Each para In ActiveDocument.Paragraphs
i = i + 1
If para.Range.ListFormat.ListType = wdNumberGallery Then
para.Style = ("List Number")
End If
Next para
End Function
The Problem is that this function sets all the specific Style to all bulletpoints in my word, but i dont know why?
I know that for bulletpoints there is the ListType wdListBullet.
Can somebody help me out?
The WdListType enumeration (https://learn.microsoft.com/en-us/office/vba/api/word.wdlisttype) does not contain a wdNumberGallery element. The integer value wdNumberGallery you are using is 2, which is equal to wdListBullet. So try using wdListSimpleNumbering or other values from the WdListType enumeration. Also, your function does not return a value, so you can use Sub instead of Function:
Sub SetNumberingStyle()
Dim para As Paragraph
For Each para In ActiveDocument.Paragraphs
If para.Range.ListFormat.ListType = wdListSimpleNumbering Then
para.Style = "List Number"
End If
Next para
End Sub
Related
I am wondering if it is possible to get to the end of the list in vba? For example, I have a document with manual numbering and autonumbering in word.
Now, I would like to apply styles. But, when applying styles to auto - numbered list the numbering would be removed upon applying another style. So, to overcome this problem I am wondering if it is possible to get to the end of the list. So, that I would convert autonumbering into manual number and apply the formatting.
Sub applyformatting()
pos2 = Selection.Range.End
pos1 = Selection.Range.Start
Dim i As Integer, para As Paragraph
For i = 1 To ActiveDocument.Range.Paragraphs.Count
Set para = ActiveDocument.Range.Paragraphs(i)
If para.Range.ListFormat.ListType <> wdListBullet Or para.Range.ListFormat.ListType <> wdListSimpleNumbering Then
' Goto the end of the list and do the following until it reaches current paragraphs
Do Until Selection.Range.Start = pos1
Selection.MoveUp wdParagraph, 1
para.Range.ListFormat.ConvertNumbersToText
para.Range.Style = "tt"
Loop
Else
para.Range.Style = "t"
End If
Next
End Sub
I wish to delete Simplified Chinese text in a document with both English and Chinese. The documents don't have any set pattern for which paragraphs are in which language.
I tried a few versions of code that search by paragraph and by language.
Sub DeleteCN()
iParCount = ActiveDocument.Paragraphs.Count
For J = 1 To iParCount
sMyPar = ActiveDocument.Paragraphs(J).Range.Text
If sMyPar.WdLanguageID = wdSimplifiedChinese Then
sMyPar.Delete
End If
Next J
End Sub
The error I get with this latest attempt is that an object is required on the If line.
You have a few issues with your code.
1) The most serious is you must reverse your loop. The loop must be reversed because as you delete a paragraph the number of paragraphs will dynamically change and then future paragraphs will no longer exist.
2) The rest are syntax errors, you can see where the syntax has been updated in the code. If you declare your variables it will be easier to know the correct syntax.
Sub DeleteCN()
Dim iParaCount As Integer
Dim para As Paragraph
iParaCount = ActiveDocument.Paragraphs.Count
For J = iParaCount To 1 Step -1
Set para = ActiveDocument.Paragraphs(J)
If para.Range.LanguageID = wdSimplifiedChinese Then
para.Range.Delete
End If
Next J
End Sub
Hope this helps.
The test code below examines paragraphs in ActiveDocument and puts 'copies' of unique paragraphs at the bottom of the document, followed by their original spacing blank paragraphs. Paragraphs are manipulated in an array, and qualifying paragraphs are then added one by one to the bottom of that document. Is there a faster way of adding those paragraphs there? I am hoping there is a way to add the array directly without needing the loop. I think that it is possible to assign an array to a range in Excel (see Rick Rothstein), but I can't see how to do that in Word 2010.
Sub FullArray()
Dim StartTime 'Start time
Dim p As Paragraph 'is each initial paragraph object in ActiveDocument
Dim pDict As New Scripting.Dictionary 'Keys=plain text versions of each inital para
'Items=signifiers of each key's (and para's)uniqueness or otherwise
Dim t As String 'Plain text version of each p, being a key of pDict
Dim pArray(1000) As Variant 'Contains all initial paragraph objects
Dim c As Integer 'c is ordinal number of each element of pArray
Dim dky As String 'dky is whichever element of pArray is to be used as a key of pDict
Dim pc As Integer 'running count of plain text paras in pDict
Dim lastdky As Integer 'signifies whether previous key of pDict is unique
'faster when dimmed, option explicit
StartTime = Timer
Application.ScreenUpdating = False 'Line 1 of Go to end of doc
ActiveDocument.Characters.Last.Select 'Line 2 of Go to end of doc. Is there a Faster way?
Selection.Collapse
'ADD each para object to Array. Write its plain text to dictionary...
'...in order to determine uniqueness of each para.
For Each p In ActiveDocument.Paragraphs
t = p.Range.Text
If Not pDict.Exists(t) Then
pDict.Add Key:=t, Item:=1 '1 flag means 1st instance of a para, including blamk paras
Else: pDict(t) = 2 '2 flag means a para which has duplicates
End If
pc = pc + 1 'count plain text paras in pDict
pArray(pc) = p 'set element number pc of Array = current paragraph object
Next p
'PLACE copies of certain paras at the end of document...
'...being those content-containing paras which were initially unique....
'...and place after each such para any following contiguous blank paras
lastdky = 1 '2/1 means PREVIOUS initial paragraph had/had not dupes.
For c = pc - 1 To 1 Step -1
dky = pArray(c)
If pDict(dky) = 1 And pArray(c) <> Chr(13) Then Selection.FormattedText = pArray(c) 'place para with content ('content paras') at end
If pArray(c) = Chr(13) And lastdky = 1 Then Selection.FormattedText = pArray(c) 'place (only) blank paras following content paras at end
If pDict(dky) = 2 Then lastdky = 2 Else: lastdky = 1
Next c
MsgBox "This code ran successfully in " & Round(Timer - StartTime, 2) & " seconds", vbInformation
Application.ScreenUpdating = True
End Sub
I have been using this code to Bold-Underline all the headers in my word doc:
Sub Underline_Headers()
Dim p As Paragraph
For Each p In ActiveDocument.Paragraphs
If Len(p.Range.Text) < 70 Then
p.Range.Font.Underline = True
p.Range.Font.Bold = True
End If
Next p
End Sub
This works great - as long as every header is less than 70 characters long, and the paragraph underneath it is 70 or more characters.
But many times the header can be longer than 70 characters, and the paragraph under the header can be less than 70 characters.
However, the headers always never end with any punctuation, like a "." but the paragraphs underneath them always do.
I am trying to fix the code above to look for all paragraphs not ending in a "." and then Bold-Underline them. In other words, I want to change the rule.
I tried the only thing that made sense to me. The code did not break, but it ended up bold-underline the entire document:
Sub Underline_Headers()
Dim p As Paragraph
For Each p In ActiveDocument.Paragraphs
If Right(p.Range.Text,1) <> "." Then
p.Range.Font.Underline = True
p.Range.Font.Bold = True
End If
Next p
End Sub
This supposedly looks for all paragraphs where the last character is not ".", which if that worked, would isolate all the headers and only bold-underline them, but obviously that doesn't work.
The last character in every paragraph is a carriage return, Chr(13). The text ends one character before that. The code below also considers the possibility that someone ended a paragraph's text with one or more blank spaces. It takes the "cleaned" string and looks for the last character in a string of possible exceptions, like .?!. You can reduce this string to a single full stop or extend it to include more cnadidates for exception.
Private Sub UnderlineTitles()
Dim Para As Paragraph
Dim Txt As String
Application.ScreenUpdating = False
For Each Para In ActiveDocument.Paragraphs
Txt = Para.Range.Text
Txt = RTrim(Left(Txt, Len(Txt) - 1))
' you can extend the list to include characters like ")]}"
If InStr(".?!", Right(Txt, 1)) = 0 Then
' to choose a different style of underline, remove
' "= wdUnderlineSingle", type "=" and select from the dropdown
Para.Range.Font.Underline = wdUnderlineSingle
End If
Next Para
Application.ScreenUpdating = True
End Sub
I have some bullets in a MS Word Document type wdListSimpleNumbering, I am unable to find a way to select all the paragraphs between bullets u) and v).
E.g. In the document, I have following bullets;
u) Company Introduction.
1st paragraph
2nd paragraph
3rd paragraph
v) Company Vision
Now I am looking a way to select the paragraphs between the bullets u) and v).
With the following code; I can select the text with bullet u) but not sure how to select range up till bullet v). Here is my code:
For Each oPara In ActiveDocument.Paragraphs
If oPara.Range.ListFormat.ListType = wdListSimpleNumbering And _
oPara.Range.ListFormat.ListString = "u)" Then _
oPara.Range.Font.ColorIndex = wdRed
oPara.Range.Select ' here I want to select paragraphs
Debug.Print (oPara)
End If
Next
Here's one way:
Sub TestSelectList()
Dim oPara As Paragraph
Dim bSelected As Boolean
For Each oPara In ActiveDocument.Paragraphs
If oPara.Range.ListFormat.ListType = wdListSimpleNumbering And _
oPara.Range.ListFormat.ListString = "u)" Then ' Make sure to remove underscore for a multiline THEN.
oPara.Range.Font.ColorIndex = wdRed
oPara.Range.Select
' Set a flag indicating that you are currently within the desired list item.
bSelected = True
Debug.Print (oPara)
ElseIf bSelected And oPara.Range.ListFormat.ListType <> wdListSimpleNumbering Then
' If the flag is positive and the current paragraph is not of the simple list type, include it in the selection.
Selection.MoveEnd wdParagraph
ElseIf oPara.Range.ListFormat.ListType = wdListSimpleNumbering Then
' Otherwise, if the paragraph is of the simple list type, turn off the flag.
bSelected = False
End If
Next
End Sub
This doesn't deal with situations where u) is the last item in the list, but I'm not sure what you'd want to do there, or how you'd know.