' global the arrays
Dim ChapterArray(1 To 900) As Integer
Dim QuestionArray(1 To 900) As String
Dim answer(1 To 900) As String
Dim sta As Integer
Dim enda As Integer
Sub GenByChapter()
' Generate Technician questions by chapters
'
Dim p As Paragraph
Dim pstring As String
Dim MaxNumber As Integer
Dim TabLocation As Integer
Dim QuestionAnaswerRange As Range
Dim StartWord As String, EndWord As String, ftest As String
Dim OldChapter As Integer


' Get information of questions by chapter in arrays
' C:\Users\Kenneth\Documents\Amateur Radio\New q downloads\questions by chapters.docx
Application.ScreenUpdating = False

Documents.Open FileName:="\Users\Kenneth\Documents\Amateur Radio\New q downloads\questions by chapters 2018.docx", ConfirmConversions _
        :=False, ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _
        PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
        WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:=""
MaxNumber = 0
For Each p In ActiveDocument.Paragraphs
    ' convert paragraph to a string of characters
    pstring = p.Range.Text
    ' drop paragraph character
    pstring = Left(pstring, Len(pstring) - 1)
        ' Debug.Print ">" & pstring & ">" & Len(pstring);
    ' find the tab - chr(9) is a tab
    TabLocation = InStr(1, pstring, Chr(9))
    MaxNumber = MaxNumber + 1
    ChapterArray(MaxNumber) = Mid$(pstring, 1, TabLocation - 1)
    QuestionArray(MaxNumber) = Mid$(pstring, TabLocation + 1)
Next p
' close the document with the questions by chapter
ActiveWindow.Close
' focus on the question document
Windows("2018-2022 Tech Pool Macro.docm").Activate
'

Windows(1).Activate
Application.ScreenUpdating = False

' a = ActiveDocument.Name
' Windows(2).Activate
i = i
a = ActiveDocument.Name
i = ActiveWindow.Index
OldChapter = -9
    Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
b = ActiveDocument.Name
ii = ActiveWindow.Index
Application.ScreenUpdating = False

Windows(ii).Activate
Application.ScreenUpdating = False

Call setmargins

Windows(i).Activate
Application.ScreenUpdating = False
sta = 1
For kk = 1 To MaxNumber
    StartWord = QuestionArray(kk)
    EndWord = "~~"
    ' build the find for the question
    Set QuestionAnaswerRange = ActiveDocument.Content
    QuestionAnaswerRange.Find.ClearFormatting
    QuestionAnaswerRange.Find.Replacement.ClearFormatting
    With QuestionAnaswerRange.Find
        .Text = StartWord & "*" & EndWord
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .MatchSoundsLike = False
        .MatchAllWordForms = False '
    End With
    ' do the find
    QuestionAnaswerRange.Find.Execute
    ' open the new window
    Windows(ii).Activate
    Application.ScreenUpdating = False

    ' see if a new chapter
    If OldChapter <> ChapterArray(kk) Then
        OldChapter = ChapterArray(kk)
        Call newchapter(OldChapter)
        sta = kk
        End If
    ' change formation back to normal
    Selection.Style = ActiveDocument.Styles("Normal")
    Selection.Font.Name = "Arial"
    Selection.Font.Size = 10
    'Selection.InsertParagraph
    ' get the found text
    ftext = QuestionAnaswerRange.Text
    ' find the first blank and then the ")"
    bl = InStr(ftext, " ")
    answer(kk) = Mid(ftext, bl + 1, 3)
    nl = InStr(ftext, Chr(13)) + 1
    fftext = QuestionArray(kk) & Chr(13) & Mid(ftext, nl)
    enda = kk
 '   Selection.TypeText (QuestionAnaswerRange.Text)
    Selection.TypeText (fftext)
    Selection.TypeParagraph
'       Debug.Print QuestionAnaswerRange.Text
If StartWord = "T2B09" Then
    kk = kk
    End If
Windows(1).Activate

Application.ScreenUpdating = False

 Next
'output a page break
    Windows(ii).Activate

Selection.InsertBreak Type:=wdPageBreak
     'spill the answers
For iii = sta To enda
    Selection.TypeText (QuestionArray(iii) & " " & answer(iii))
    Selection.TypeParagraph
Next
Windows(1).Activate

 Application.ScreenUpdating = True
 
 ' ww = ww
' Selection.InsertParagraph
'Dim MyText As String
 ' MyText = "<Replace this with your text>"
'  Selection.TypeText (MyText)
'objSelection.TypeParagraph (" ")
'objSelection.TypeText "This text was apstringended to an existing Word document."
    End Sub
Sub newchapter(i)
' Dim i As Integer
If i <> 1 Then
    'output a page break
     Selection.InsertBreak Type:=wdPageBreak
     'spill the answers
     For ii = sta To enda
        Selection.TypeText (QuestionArray(ii) & " " & answer(ii))
        Selection.TypeParagraph
        Next
    

    Selection.InsertBreak Type:=wdSectionBreakNextPage
    End If
'set up new page heading for chapter
ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
' Selection.HeaderFooter.LinkToPrevious = False
With ActiveDocument.Sections.Last
    With .Headers(1)
        .LinkToPrevious = False
    End With
    With .Headers(2)
        .LinkToPrevious = False
    End With
    With .Headers(3)
        .LinkToPrevious = False
    End With
 End With

Selection.Font.Size = 20
Selection.Font.Name = "Arial"
secNum = Selection.Information(wdActiveEndSectionNumber)
ActiveDocument.Sections(i).Headers(wdHeaderFooterPrimary).Range.Text = vbNullString
ActiveDocument.Sections(i).Headers(wdHeaderFooterPrimary).Range.Text = "Questions for chapter " & i
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Selection.TypeParagraph
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

Selection.TypeParagraph
' change formation back to normal
Selection.Style = ActiveDocument.Styles("Normal")
Selection.Font.Name = "Arial"

    End Sub
    
Sub newdoc()
'
' newdoc Macro
' new doc
'

'
    Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
    Selection.TypeParagraph
End Sub

Sub setmargins()
    With ActiveDocument.PageSetup
        .LineNumbering.Active = False
        .Orientation = wdOrientPortrait
        .TopMargin = InchesToPoints(0.3)
        .BottomMargin = InchesToPoints(0.3)
        .LeftMargin = InchesToPoints(0.4)
        .RightMargin = InchesToPoints(0.3)
        .Gutter = InchesToPoints(0)
        .HeaderDistance = InchesToPoints(0.5)
        .FooterDistance = InchesToPoints(0.5)
        .PageWidth = InchesToPoints(8.5)
        .PageHeight = InchesToPoints(11)
        .FirstPageTray = wdPrinterDefaultBin
        .OtherPagesTray = wdPrinterDefaultBin
        .SectionStart = wdSectionNewPage
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .VerticalAlignment = wdAlignVerticalTop
        .SuppressEndnotes = False
        .MirrorMargins = False
        .TwoPagesOnOne = False
        .BookFoldPrinting = False
        .BookFoldRevPrinting = False
        .BookFoldPrintingSheets = 1
        .GutterPos = wdGutterPosLeft
    End With
End Sub