Bulletted List Creation

jdean · #1 11-08-2013, 09:53 PM

Hi,

I am comfortable in xl VBA but not so much in Word (using Word 2010) and I hope someone can assist. Here's my problem:

In a word document, let's call the doc TEST.docx, I need macro to loop through all the paragraphs in the document and ..

1. if a paragraph starts with the word "Met" then that paragraph should be bulletted (with a solid bullet from the Word bullet list dropdown i.e. one with ListLevels(1).NumberFormat = ChrW(61623), I think) . Spacing between bullet and paragraph should be about 1 inch

2. but if a paragraph starts with the word "Exceeded" then that paragraph should be bulletted with the symbol like the hollow circle or "O" in the Word bullet list dropdown. Also this paragraph must be indented about 2 inches from the left margin (together with the hollow bullet) and Spacing between bullet and paragraph should be about 1 inch

I hope I explained myself well and would appreciate your help. Tried mac recording and have spent hours and hours without success.

Thanks!
Jay

macropod · #2 11-09-2013, 12:49 AM

Cross-posted at: http://www.excelforum.com/word-progr...rd-2010-a.html
For cross-posting etiquette, please read: http://www.excelguru.ca/content.php?184

macropod · #3 11-09-2013, 12:53 AM

If you define two appropriate paragraph Styles, which is the 'correct' way to manage paragraph formatting, you can do the lot using Find/Replace. No code required.

jdean · #4 11-09-2013, 06:34 AM

Quote:

Originally Posted by macropod

If you define two appropriate paragraph Styles, which is the 'correct' way to manage paragraph formatting, you can do the lot using Find/Replace. No code required.

I will really need a VBA code, so if you can help me, I would appreciate it.
... I am sorry for cross-posting. I was getting submission errors when I tried to post it on one forum. That was why I tried the second.

Thanks!
Jay

macropod · #5 11-09-2013, 01:15 PM

Hi Jay,

There is far more to applying a required paragraph format than just indenting them and adding bullets. Try defining the two Styles 'BulletA' and 'BulletB', with all of the required attributes, then running the following macro to apply them:

Code:

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "^13Met[!^13]@^13"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    With .Duplicate
      .Start = .Start + 1
      .Style = "Style1"
    End With
    .End = .End - 1
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
  .Start = 0
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "^13Exceeded[!^13]@^13"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    With .Duplicate
      .Start = .Start + 1
      .Style = "Style2"
    End With
    .End = .End - 1
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub

jdean · #6 11-09-2013, 02:03 PM

Macropod, I really appreciate your code. The problem is that the macro will run on a different instance of Word each time. Basically, the macro is in XL sheet..

1. It creates a new Word document object and then imports data from XL into the Word document. Every part of the code works great, except bulletting and indenting the paragraphs that have those conditions. Further, different people will be running the code on their pcs, so creating two bullet styles - A and B on my pc is not viable.

2. In other words, the 2 styles "BulletA" and "BulletB" must be created via VBA at every instantiation of a new Word object (if the two styles don't exist already for the user) and applied to the targeted paragraphs.

** After taking a stab at recording a macro, I was able to come up with something along these lines.

Code:

Dim opara as word.paragraph
'-- Assuming the newly created active doc is MyDoc then I do
For Each oPara In MyDoc.Paragraphs
   if oPara.Range.Words(1).Text="Met" then
     oPara.Range.ListFormat.ApplyListTemplate ListGalleries(wdBulletGallery).ListTemplates(1).ListLevels(1).NumberFormat = ChrW(61623)
  else if oPara.Range.Words(1).Text="Exceeded" then
     oPara.Range.ListFormat.ApplyListTemplate  ListGalleries(wdBulletGallery).ListTemplates(1).ListLevels(1).NumberFormat  = "o"
end if
Next

However, when I run it, I get the RUNTIME ERROR: "424" Object Required, highlighting the lines starting with "oPara.Range.ListFormat.ApplyListTemplate..." in the code

So,I guess it is not recognizing the opara.range as a "range object"? What do I appear to be doing wrong? This stuff has stressed me for a few days now.

Thanks!
Jay

macropod · #7 11-10-2013, 12:05 AM

Hard-formatting (i.e. overriding whatever Style is already applied to the content) is poor practice; it can lead to inconsistencies, makes the document harder to manage and introduce corruption.

The absence of the required styles in the target documents is easily-enough handled:

Code:

Sub Demo()
Application.ScreenUpdating = False
Dim Stl As Style, bBulletA As Boolean, bBulletB As Boolean, Rng As Range
bBulletA = False: bBulletB = False
For Each Stl In ActiveDocument.Styles
  If Stl.NameLocal = "BulletA" Then bBulletA = True
  If Stl.NameLocal = "BulletB" Then bBulletB = True
Next
If bBulletA = False Then Call AddBulletStyle("BulletA", ChrW(&H25CF))
If bBulletB = False Then Call AddBulletStyle("BulletB", "o")
Set Rng = ActiveDocument.Range
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "^13Met[!^13]@^13"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    .Start = .Start + 1
    .End = .End - 1
    .Style = "BulletA"
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
  .Start = Rng.Start
  .End = Rng.End
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "^13Exceeded[!^13]@^13"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    .Start = .Start + 1
    .End = .End - 1
    .Style = "BulletB"
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub
 
Private Sub AddBulletStyle(StrNm As String, StrBullet As String)
Dim Stl As Style
Set Stl = ActiveDocument.Styles.Add(Name:=StrNm, _
  Type:=wdStyleTypeParagraph)
With ListGalleries(wdBulletGallery).ListTemplates(1).ListLevels(1)
  .NumberFormat = StrBullet
  .TrailingCharacter = wdTrailingTab
  .NumberStyle = wdListNumberStyleBullet
  .NumberPosition = InchesToPoints(0)
  .Alignment = wdListLevelAlignLeft
  .TextPosition = InchesToPoints(1)
  .TabPosition = InchesToPoints(1)
  .ResetOnHigher = 0
  .StartAt = 1
  .LinkedStyle = StrNm
End With
With Stl
  .AutomaticallyUpdate = False
  .BaseStyle = "Normal"
  .LinkToListTemplate _
    ListTemplate:=ListGalleries(wdBulletGallery).ListTemplates(1), _
    ListLevelNumber:=1
  With .ParagraphFormat
    .LeftIndent = InchesToPoints(1)
    .RightIndent = InchesToPoints(0)
    .FirstLineIndent = InchesToPoints(-1)
    .TabStops.ClearAll
    .TabStops.Add Position:=InchesToPoints(1), _
      Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
  End With
End With
End Sub

jdean · #8 11-10-2013, 09:22 AM

Macropod, I copied Private Sub AddBulletStyle and placed it in the "General Section" of the module as I would for a function. I then copied Sub Demo into my code. Is this correct?

However, when I compiled, I got a compiler in Sub Demo code, that highlights the last ".End" in the line .End = Rng.End and says, "Argument not optional"

Thanks!
Jay

macropod · #9 11-10-2013, 02:17 PM

Quote:

Originally Posted by jdean

Macropod, I copied Private Sub AddBulletStyle and placed it in the "General Section" of the module as I would for a function. I then copied Sub Demo into my code. Is this correct?

As I haven't seen the rest of your code, I can't really say whether what you've done is 'correct'. One might just as easily re-name the sub, then Call it from your existing one.

Quote:

However, when I compiled, I got a compiler in Sub Demo code, that highlights the last ".End" in the line .End = Rng.End and says, "Argument not optional"

Did you adjust the 'Rng' variable to reference Word.Range? Likewise, based on what you've posted so far, you should change 'ActiveDocument' to 'MyDoc'.

jdean · #10 11-10-2013, 06:37 PM

Macropod,
I followed your suggestions by qualifying the rng object, activedocument etc., ran it and I'm happy to say it is getting very close to what I want. However, I must admit I don't think I made my requirements quite clear enough in the beginning but I think if you can re-tweak the code slightly to meet the following conditions I will be good.

1. If the first word of a paragraph is "Drafted" do Nothing. Don't touch the paragraph.

2. If (the first word of a paragraph IS NOT "Drafted") and (the first word of the same paragraph IS NOT "Exceeded") then apply the bullet ChrW(61623). **NOTE: Bullet should be on/or closest to page margin but distance between the bullet and the paragraph should be about 0.5 inch. Also, the paragraph font.bold = true

3. If the first word of a paragraph is "Exceeded" then apply the hollow circle bullet "O" . NOTE**: Bullet should be 1 inch from page margin but distance between the bullet and the paragraph should be about 0.5 inch. Also the paragraph font.bold = false

4. In any case do not change the current paragraph.spacesafter or spacebefore setting between any two paragrapghs

Thanks in advance. This is so close!
Jay

macropod · #11 11-10-2013, 07:16 PM

Those are rather different requirements than what you previously specified.

Quote:

1. If the first word of a paragraph is "Drafted" do Nothing. Don't touch the paragraph.

This is the first mention of "Drafted" but, even so, the code doesn't affect such paragraphs.

Quote:

2. If (the first word of a paragraph IS NOT "Drafted") and (the first word of the same paragraph IS NOT "Exceeded")

So that's every paragraph, even those beginning with 'Met', even if they don't start with 'Drafted' or 'Exceeded'? If so, why don't you simply define the Normal Style and/or whatever other Styles you're already using with that specification? Then we need only modify the ones with 'Drafted' or 'Exceeded'!

Quote:

4. In any case do not change the current paragraph.spacesafter or spacebefore setting between any two paragrapghs

The code doesn't explicitly do that - it simply bases everything for its bullet Styles on the Normal Style. If, however, you want to specify a different space before/after setting for your bullet Style, then do so. If, however, you've got inconsistent before/after spacing for the paragraphs you want to work on, that suggests poor document design.

What's happened to the paragraphs beginning with 'Met'?

jdean · #12 11-10-2013, 09:37 PM

Macropod,

I just received the newest version of the doc and "Drafted" was in but "Met" had been removed. Unfortunately, I had posted before then, so that is entirely my error and I apologize. The paragraph whose first word is "Drafted" will be the first paragraph. It is just one paragraph and nothing needs to be done to it but if any style is applied to it, it still won't be a big deal.

So it boils down to just these 2 conditions:

1. If the first word of a paragraph is "Exceeded" then apply the hollow circle bullet "O" . NOTE: Bullet should be 1 inch from page margin but distance between the bullet and the paragraph should be about 0.5 inch. Also the paragraph font.bold = false

2. Every other paragraph else, apply the bullet ChrW(61623). NOTE: Bullet should be on/or closest to page margin but distance between the bullet and the paragraph should be about 0.5 inch. Also, the paragraph font.bold = true.

So sorry for the confusion. My apologies.
Jay

macropod · #13 11-10-2013, 11:24 PM

Try something based on:

Code:

Sub Demo()
Application.ScreenUpdating = False
Dim Stl As Style, bBulletA As Boolean, bBulletB As Boolean
bBulletA = False: bBulletB = False
For Each Stl In ActiveDocument.Styles
  If Stl.NameLocal = "BulletA" Then bBulletA = True
  If Stl.NameLocal = "BulletB" Then bBulletB = True
Next
If bBulletA = False Then Call AddBulletStyle("BulletA", ChrW(61623), InchesToPoints(0), InchesToPoints(0.5), True)
If bBulletB = False Then Call AddBulletStyle("BulletB", "o", InchesToPoints(1), InchesToPoints(1.5), False)
With ActiveDocument.Range
  .Style = "BulletA"
  .Paragraphs.First.Style = "Normal"
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "^13Exceeded[!^13]@^13"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    .Start = .Start + 1
    .End = .End - 1
    .Style = "BulletB"
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub
 
Private Sub AddBulletStyle(StrNm As String, StrBullet As String, iIndnt As Single, iHang As Single, bFntBld As Boolean)
Dim Stl As Style
Set Stl = ActiveDocument.Styles.Add(Name:=StrNm, Type:=wdStyleTypeParagraph)
With ListGalleries(wdBulletGallery).ListTemplates(1).ListLevels(1)
  .NumberFormat = StrBullet
  .TrailingCharacter = wdTrailingTab
  .NumberStyle = wdListNumberStyleBullet
  .NumberPosition = InchesToPoints(0)
  .Alignment = wdListLevelAlignLeft
  .ResetOnHigher = 0
  .StartAt = 1
  .LinkedStyle = StrNm
End With
With Stl
  .AutomaticallyUpdate = False
  .BaseStyle = "Normal"
  .LinkToListTemplate _
    ListTemplate:=ListGalleries(wdBulletGallery).ListTemplates(1), ListLevelNumber:=1
  With .ParagraphFormat
    .LeftIndent = iHang
    .RightIndent = InchesToPoints(0)
    .FirstLineIndent = -iHang + iIndnt
    .TabStops.ClearAll
    .TabStops.Add Position:=iHang, _
      Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
  End With
  .Font.Bold = bFntBld
End With
End Sub

jdean · #14 11-11-2013, 07:20 AM

Macropod,

I tested the code several times. Each time, it seems to work the first time, but when I run it again, I get: Run-Time Error '462': The remote server machine does not exist or is unavailable.

This is how I have my code set up from an Excel activeX control:

Code:

'== I placed Sub AddBullet () in the "General Section" of the Module. The only change I made there was change Stl As Style to Stl As Word.Style

'== Followed by my code:
Sub Mycode()
 t=Worksheets(1).Range("A3:A10000").SpecialCells(xlCellTypeConstants).Cells.Count
    Set a = Worksheets(1).Range("A5").Cells
    Set b = Worksheets(1).Range("B5").Cells
    Dim wrdApp As Word.Application
    Dim wrdDoc As Word.Document
    Dim strFirstWord As String
    Dim oPara As Word.Paragraph
    Set wrdApp = CreateObject("Word.Application")
    wrdApp.Visible = True
    Set wrdDoc = wrdApp.Documents.Add

    Application.ScreenUpdating = false
    wrdApp.WindowState = wdWindowStateMinimize

    With wrdApp.Selection
       .TypeText Text:="Drafted" &  Something
       .TypeParagraph
        For i = 1 To t
            .ParagraphFormat.LineSpacingRule = wdLineSpaceSingle
            .ParagraphFormat.LineSpacing = 10
            .TypeText Text:=a.Value
            .TypeParagraph
            .TypeText Text:=b.Value
            .TypeParagraph
            Set a = a.Offset(1, 0).Cells
            Set b = b.Offset(1, 0).Cells
        Next i
     End With
    
    
     For Each oPara In wrdDoc.Paragraphs
        strFirstWord = oPara.Range.Words(1).Text
        With oPara.Range.Font
             .Name = "Tahoma"
             .Size = 10
        End With
        If Trim(strFirstWord) = "Drafted" Then
           oPara.Range.Font.Bold = True
        ElseIf Trim(strFirstWord) <> "Drafted" And Trim(strFirstWord) <> "Exceeded" Then
           oPara.Range.Font.Bold = True
           oPara.SpaceAfter = 0 
        ElseIf Trim(strFirstWord) = "Exceeded" Then
           For i = 2 To 20
               oPara.Range.Characters(i).Font.Italic = True
           Next i
        End If
    Next

'== Followed by Demo()  WIITHIN MyCode entered as
    Dim Stl As Word.Style, bBulletA As Boolean, bBulletB As Boolean
    bBulletA = False: bBulletB = False
    For Each Stl In wrdDoc.Styles
      If Stl.NameLocal = "BulletA" Then bBulletA = True
      If Stl.NameLocal = "BulletB" Then bBulletB = True
    Next
    If bBulletA = False Then Call AddBulletStyle("BulletA", ChrW(61623), InchesToPoints(0), InchesToPoints(0.5), True)
    If bBulletB = False Then Call AddBulletStyle("BulletB", "o", InchesToPoints(1), InchesToPoints(1.5), False)
    With wrdDoc.Range
      .Style = "BulletA"
      .Paragraphs.First.Style = "Normal"
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "^13Exceeded[!^13]@^13"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchWildcards = True
        .Execute
      End With
      Do While .Find.Found
        .Start = .Start + 1
        .End = .End - 1
        .Style = "BulletB"
        .Collapse wdCollapseEnd
        .Find.Execute
      Loop
    End With

'== Followed by

    wrdApp.WindowState = wdWindowStateNormal
    Set wrdApp = Nothing
    Set wrdDoc = Nothing
     Application.ScreenUpdating = True
end sub

Thanks!
Jay

macropod · #15 11-11-2013, 02:35 PM

I see that you have 'Set wrdApp = Nothing', but I don't see where you've terminated the wrdApp session (i.e. wrdApp.Quit). Not having that means you'll have an orphaned Word session floating around.

Hint: Since it seems you want your Word session to be running for multiple documents, you should start the Session independently of all the looping that opens the documents, then kill it once all the processing has been done. See, for example: https://www.msofficeforums.com/excel...readsheet.html

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Calendar Creation	sjvjoe	Publisher	1	07-14-2016 06:32 PM
Document Creation	Privateer	Word	3	06-20-2013 08:15 PM
Help with Complex Table Creation	saquib	Word	0	02-12-2013 06:28 AM
Label Creation	speloquin	Word	1	05-27-2011 03:08 PM
Report creation.	Igtech	Excel	1	04-02-2010 03:33 PM