none
How to write a VBA script for adding comments based on headings? RRS feed

  • Question

  • Hello Everyone,

    I have been trying to write a VBA macro for adding comments into my word document based on headings. The problem is that the document may or may not always follow word style 'heading' to add a heading. This is why I am trying to use 'ListFormat.ListLevelNumber' to get the level number and add a comment.

    As a trial first I wanted to just print the level number but I am getting a run time error '5941' - The requested member of the collection does not exist.

    I think the way I am trying to move the selection from one heading to another is not right. I tried reading about this error type but nothing I could make out.

    Option Explicit
    
    'script to insert TAGs as comment based on word document outline.
    ' The format of TAG is provided by user and also the step by which TAG number need to be incremented
    Public Sub CreateOutline()
       ' Variable for holding range of selection
       Dim Rng As Word.Range
       ' Variable for holding extracted headings
       Dim astrHeadings As Variant
       Dim strText As String
       Dim intLevel As Integer
       Dim intItem As Integer
       Dim minLevel As Integer
       Dim iParCount As Integer
       Dim i As Integer
       
       'string variable to get the TAG prefix and starting point.
       Dim tagInput As String
       ' integer input used as step to increment TAGs
       Dim intStep As Integer
       'variable to hold current paragraph
       Dim pCur As Sentences
       Dim sCur As Sections
       Application.Templates.LoadBuildingBlocks
       iParCount = ActiveDocument.Paragraphs.Count
       MsgBox iParCount
       
       For i = 1 To iParCount
          Selection.Paragraphs(i).Range.Select
          If Selection.Paragraphs(i).Range.ListParagraphs.Count = 1 Then
             MsgBox Selection.Paragraphs(i).Range.ListFormat.ListLevelNumber
             MsgBox Selection.Paragraphs(i).OutlineLevel
          End If
       Next
          MsgBox "End of script"

    Thanks to Starain's input now my script is working or I should say sort of working. I did some changes based on inputs but still there are couple of issues.

    1.) script is very slow and sometimes my word application crashes.

    2.) sometimes I get a runtime error 4605 'This command is not available' for line "Selection.Comments.Add Range:=Para.Range, text:="[" & sIdLabel & sCurrentNumber & "]" & vbCrLf  ' ID‘}"

    Here is my updated code

    'script to insert TAGs as comment based on word document outline.
    ' The format of TAG is provided by user and also the step by which TAG number need to be incremented
    Sub CreateOutline()
        Dim sIdLabel As String
        Dim sCurrentNumber As String
        Dim sStepNumber As String
        Dim Para As Paragraph
       Application.Templates.LoadBuildingBlocks
       'get the TAG format from user.
       sIdLabel = InputBox("Provide the TAG ID", "TS_FS_")
       sCurrentNumber = InputBox("Provide the Current number", "001")
       'get the step by which the TAG number is to be incremented everytime.
       sStepNumber = InputBox("Provide the step", "1")
       For Each Para In ActiveDocument.Paragraphs
          If Para.Range.ListParagraphs.Count = 1 Then
             Para.Range.Select
             Selection.Move wdParagraph, 1
             Selection.Comments.Add Range:=Para.Range, text:="[" & sIdLabel & sCurrentNumber & "]" & vbCrLf  ' ID‘}
             sCurrentNumber = Format(Val(sCurrentNumber) + Val(sStepNumber), String(Len(sCurrentNumber), "0"))
          End If
       Next Para
    End Sub

    • Edited by AshishK15 Thursday, April 9, 2015 2:24 PM Errors in further execution
    Tuesday, April 7, 2015 11:02 AM

Answers

  • See http://word.mvps.org/faqs/numbering/liststring.htm.

    Stefan Blom, Microsoft Word MVP

    • Marked as answer by AshishK15 Wednesday, April 8, 2015 8:22 AM
    Tuesday, April 7, 2015 12:57 PM
  • Hi AshishK15,

    Base on your code, I think the exception is threw in the code of Selection.Paragraphs(i).Range.Select.

    For your code, you are getting the all paragraphs of the document (iParCount), however you are using the Selection object to get all paragraphs, which is incorrect unless you select the whole document content.

    So, please modify the Selection to ActiveDocument.

     For i = 1 To iParCount
          ActiveDocument.Paragraphs(i).Range.Select
          If ActiveDocument.Paragraphs(i).Range.ListParagraphs.Count = 1 Then
             MsgBox ActiveDocument.Paragraphs(i).Range.ListFormat.ListLevelNumber
             MsgBox ActiveDocument.Paragraphs(i).OutlineLevel
          End If
       Next
    

    Regards

    Starain

    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    • Marked as answer by AshishK15 Wednesday, April 8, 2015 8:22 AM
    Wednesday, April 8, 2015 6:21 AM
    Moderator

All replies

  • See http://word.mvps.org/faqs/numbering/liststring.htm.

    Stefan Blom, Microsoft Word MVP

    • Marked as answer by AshishK15 Wednesday, April 8, 2015 8:22 AM
    Tuesday, April 7, 2015 12:57 PM
  • Hi Stefan,

    Thanks for the link, I have referred the link but I am not sure why I am getting runtime error?

    Tuesday, April 7, 2015 3:30 PM
  • The example macros in the article must be added to a sub routine in the Visual Basic Editor. That may be the cause of the error, but it would help if you cited the error message.


    Stefan Blom, Microsoft Word MVP

    Tuesday, April 7, 2015 6:04 PM
  • Hi AshishK15,

    Base on your code, I think the exception is threw in the code of Selection.Paragraphs(i).Range.Select.

    For your code, you are getting the all paragraphs of the document (iParCount), however you are using the Selection object to get all paragraphs, which is incorrect unless you select the whole document content.

    So, please modify the Selection to ActiveDocument.

     For i = 1 To iParCount
          ActiveDocument.Paragraphs(i).Range.Select
          If ActiveDocument.Paragraphs(i).Range.ListParagraphs.Count = 1 Then
             MsgBox ActiveDocument.Paragraphs(i).Range.ListFormat.ListLevelNumber
             MsgBox ActiveDocument.Paragraphs(i).OutlineLevel
          End If
       Next
    

    Regards

    Starain

    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    • Marked as answer by AshishK15 Wednesday, April 8, 2015 8:22 AM
    Wednesday, April 8, 2015 6:21 AM
    Moderator
  • Hi Starain,

    Thanks for your reply. It was really helpful. I'm able to proceed but sometime now I get a different error which I am not sure why. I have updated the code and error in main text. Please let me know if you can provide any help.

    Thanks

    Ashish

    Thursday, April 9, 2015 2:26 PM
  • Hi Ashish,

    If the different error is not directly related to the original issue, it would be better if you open up a new thread for the new question. In this way, our discussion here will not deviate too much from the original issue. This will make answer searching in the forum easier and be beneficial to other community members as well.

    Regards

    Starain


    We are trying to better understand customer views on social support experience, so your participation in this interview project would be greatly appreciated if you have time. Thanks for helping make community forums a great place.
    Click HERE to participate the survey.

    Friday, April 10, 2015 6:33 AM
    Moderator
  • Ok Starain. added a new question.

    https://social.msdn.microsoft.com/Forums/office/en-US/fc6e77ea-fbba-423f-b361-42d5cd340dfc/runtime-error-4605-and-word-application-crashing?forum=worddev

    Friday, April 10, 2015 7:58 AM