View Single Post
 
Old 01-03-2019, 08:53 AM
gmaxey gmaxey is offline Windows 10 Office 2016
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,601
gmaxey is just really nicegmaxey is just really nicegmaxey is just really nicegmaxey is just really nicegmaxey is just really nice
Default

If each question consists of a single paragraph and there are no other paragraphs in the document (including empty paragraphs) then something like this mash of unorganized mess might do. I don't have time to refine:

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
    oCol.Add Left(oRng.Paragraphs(lngIndex).Range.Text, Len(oRng.Paragraphs(lngIndex).Range.Text) - 1)
  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
  oRngDup.Delete
  ActiveDocument.Paragraphs(1).Range.Delete
lbl_Exit:
  Exit Sub
End Sub
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote