Microsoft Office Forums - View Single Post - [Solved] How to I create a macro that dynamically creates a table, to enter questions, in the below format?

gmaxey · 01-04-2019, 06:37 AM

If you created a style "Questions" and applied it to each paragraph that was a question then something like this bigger mess might do:

Code:

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey, http://gregmaxey.com/word_tips.html, 1/3/2019
Dim oCol As New Collection
Dim lngIndex As Long
Dim oTbl As Table
Dim oRng As Range, oRngDup As Range
  Set oRng = ActiveDocument.Range
  For lngIndex = 1 To oRng.Paragraphs.Count
    If oRng.Paragraphs(lngIndex).Style = "Questions" Then
      oCol.Add Left(oRng.Paragraphs(lngIndex).Range.Text, Len(oRng.Paragraphs(lngIndex).Range.Text) - 1)
    End If
  Next
  Set oRngDup = oRng.Duplicate
  oRng.Collapse wdCollapseEnd
  oRng.InsertBefore vbCr
  oRng.Collapse wdCollapseEnd
  oRngDup.End = oRng.Start
  Set oTbl = oRng.Tables.Add(oRng, 4, 2)
  With oTbl
    .Style = "Table Grid"
        For lngIndex = 1 To 4
      .Cell(lngIndex, 1).Borders(wdBorderBottom).LineStyle = wdLineStyleNone
    Next lngIndex
    .Columns(1).Width = 18
    .AutoFitBehavior wdAutoFitWindow
    .Cell(1, 2).Range.Text = oCol.Item(1)
    For lngIndex = 2 To oCol.Count
      .Rows.Add
      .Rows.Last.Cells(2).Range.Text = oCol.Item(lngIndex)
      .Rows.Add
      .Rows.Add
      .Rows.Add
    Next
    For lngIndex = 4 To .Rows.Count Step 4
      .Cell(lngIndex, 1).Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
    Next lngIndex
  End With
  For lngIndex = oRngDup.Paragraphs.Count To 1 Step -1
    If oRngDup.Paragraphs(lngIndex).Style = "Questions" Then
      oRngDup.Paragraphs(lngIndex).Range.Delete
    End If
  Next lngIndex
lbl_Exit:
  Exit Sub
 End Sub