สืบเนื่องจากกระทู้ ของคุณ ray1 สอบถามเรื่อง การพิมพ์คำต่อเนื่องที่จะยกไปพิมพ์หน้าใหม่ใน Microsoft Word ครับ [หนังสือราชการ]
https://ppantip.com/topic/30726703
ซึ่งเป็นกระทู้ทั้งแต่ปี พ.ศ. 2556 ผ่านไป 10 กว่าปีแล้ว พบว่ายังคงมีการใช้งานในหนังสือราชการอยู่  

ผมจึงลองเขียนโค้ด Macros ง่ายๆ เพื่อแก้ปัญหานี้ สำหรับใครหลายคนที่จำเป็นจะต้องทำเอกสารราชการ
ยิ่งจำนวนเอกสารหลายหน้า คงทราบดีว่าหากมีการแก้ไขเอกสารแล้วหน้าเลื่อน จะงานเข้าเลยทีเดียว
เพราะท่านจะต้องแก้กล่องข้อความนี้ "ทุกหน้า!" ทุกครั้งที่แก้เอกสารแล้วหน้าเลื่อน

จึงเป็นที่มาของการเขียนโค๊ดนี้ขึ้น และเห็นว่ามีคนสนใจนำไปใช้งานจริง
ผมเลยขอตั้งกระทู้ใหม่ เพื่อเข้าถึงกระทู้นี้ได้ง่าย และให้อยู่ในหมวดของการพัฒนาซอฟแวร์ด้วย
เผื่อมีท่านอื่นช่วยพัฒนาให้ดียิ่งขึ้น 
 
อ้างอิง
https://ppantip.com/topic/30726703/comment7-6

โค้ดหลัก Update 20/03/2568 - ปรับปรุงการตัดคำ และแก้ไขตำแหน่งกล่องข้อความ
[Spoil] คลิกเพื่อดูข้อความที่ซ่อนไว้Sub CreateTextBoxEveryPage()
    Dim doc As Document, pageCount As Long, i As Long
    Set doc = ActiveDocument
    pageCount = doc.ComputeStatistics(wdStatisticPages)
    If pageCount < 2 Then
        MsgBox "เอกสารมีหน้าไม่เพียงพอสำหรับการสร้างกล่องข้อความ", vbExclamation
        Exit Sub
    End If

    Dim reTemp As Object
    Set reTemp = CreateObject("VBScript.RegExp")
    reTemp.Pattern = "[ก-๙]"
    reTemp.IgnoreCase = True
    reTemp.Global = True

    Dim maxLen As Long
    maxLen = 8  ' กำหนดความยาวสูงสุดของ token2

    Dim rng As Range, nextPageRange As Range
    Dim token1 As Range, token2 As Range, rngWord As Range
    Dim tokenCount As Long
    Dim shp As Shape

    For i = 1 To pageCount - 1
        ' กำหนด Anchor ของหน้าปัจจุบัน
        Set rng = doc.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=i)
        rng.Collapse wdCollapseStart

        ' กำหนดช่วงข้อความของหน้าถัดไป
        Set nextPageRange = doc.GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=i + 1)
        nextPageRange.End = doc.Range(nextPageRange.Start, doc.Content.End).End

        tokenCount = 0
        Set token1 = Nothing: Set token2 = Nothing
        ' วนลูปผ่าน Words collection เพื่อค้นหาคำภาษาไทย
        For Each rngWord In nextPageRange.Words
            If reTemp.Test(Trim(rngWord.Text)) Then
                tokenCount = tokenCount + 1
                If tokenCount = 1 Then
                    Set token1 = rngWord.Duplicate
                ElseIf tokenCount = 2 Then
                    Set token2 = rngWord.Duplicate
                    Exit For
                End If
            End If
        Next rngWord

        ' สร้าง TextBox โดยจัดวางให้อยู่ท้ายกระดาษและเอาเส้นกรอบออก
        Set shp = doc.Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _
                    Left:=doc.PageSetup.PageWidth - doc.PageSetup.RightMargin - (4 * 28.3465), _
                    Top:=doc.PageSetup.PageHeight - doc.PageSetup.BottomMargin - (1 * 28.3465), _
                    Width:=4 * 28.3465, _
                    Height:=1 * 28.3465, _
                    Anchor:=rng)
        shp.Line.Visible = msoFalse

        With shp.TextFrame.TextRange
            .Text = ""  ' ล้างข้อความก่อนเริ่ม
            ' นำ token1 (พร้อมสไตล์) มาใส่
            If Not token1 Is Nothing Then .FormattedText = token1.FormattedText
            .Collapse wdCollapseEnd
            .InsertAfter " "
            ' นำ token2 (พร้อมสไตล์) มาใส่ โดยตัดความยาวหากจำเป็น
            If Not token2 Is Nothing Then
                Dim token2Trim As Range
                Set token2Trim = token2.Duplicate
                If token2Trim.Characters.Count > maxLen Then
                    token2Trim.End = token2Trim.Start + maxLen
                End If
                .Collapse wdCollapseEnd
                .FormattedText = token2Trim.FormattedText
            End If
            .Collapse wdCollapseEnd
            .InsertAfter "..."
            ' ปรับข้อความใน TextBox ให้ชิดขวา
            .ParagraphFormat.Alignment = wdAlignParagraphRight
        End With
    Next i

    MsgBox "กล่องข้อความถูกสร้างในทุกหน้าสำเร็จ!", vbInformation
End Sub
โค้ดสร้าง ปุ่มใน Toolbar
[Spoil] คลิกเพื่อดูข้อความที่ซ่อนไว้Sub AddMacroToToolbar()
    Dim cBar As CommandBar
    Dim cBarControl As CommandBarControl
    
    ' สำหรับ Word รุ่นใหม่ (Ribbon UI) วิธีนี้อาจไม่สามารถทำงานได้
    ' ลบปุ่มเก่า (ถ้ามีอยู่แล้ว)
    On Error Resume Next
    Application.CommandBars("Standard").Controls("สร้างข้อความต่อเนื่อง").Delete
    On Error GoTo 0
    
    ' เพิ่มปุ่มใน Toolbar (สำหรับ Word รุ่นเก่า)
    Set cBar = Application.CommandBars("Standard")
    Set cBarControl = cBar.Controls.Add(Type:=msoControlButton, Temporary:=True)
    
    With cBarControl
        .Caption = "สร้างข้อความต่อเนื่อง"
        .Style = msoButtonCaption
        .OnAction = "CreateTextBoxEveryPage"
    End With
    
    MsgBox "ปุ่ม 'สร้างข้อความต่อเนื่อง' ถูกเพิ่มใน Toolbar แล้ว!", vbInformation
End Sub
โค้ดสำหรับการลบปุ่มเดิมใน Toolbar อออก (ถ้ามี)
[Spoil] คลิกเพื่อดูข้อความที่ซ่อนไว้Sub DeleteAllTextBox()
    Dim doc As Document
    Dim shp As Shape
    Dim i As Integer
    
    Set doc = ActiveDocument
    
    ' วนลูปย้อนกลับเพื่อลบเฉพาะ TextBox ที่มี AlternativeText ว่า "NextPageTextBox"
    For i = doc.Shapes.Count To 1 Step -1
        Set shp = doc.Shapes(i)
        If shp.Type = msoTextBox And shp.AlternativeText = "NextPageTextBox" Then
            shp.Delete
        End If
    Next i
    
    MsgBox "กล่องข้อความที่สร้างโดยมาโครถูกลบแล้ว!", vbInformation
End Sub
วิธีนำไปใช้งาน
[Spoil] คลิกเพื่อดูข้อความที่ซ่อนไว้1. (การติดตั้ง) เปิดเอกสาร Word ที่ต้องการใช้งานมาโคร (หรือสร้างเอกสารใหม่)
- กด Alt + F11 เพื่อเข้าสู่หน้าต่าง VBA Editor (หรือไปเปิดแทป Developer แล้วเลือก Macros)
- สร้างโมดูลใหม่แล้ววางโค้ดที่ปรับปรุงแล้วลงไป

2. สร้างกล่องข้อความในทุกหน้า:
- รันมาโคร CreateTextBoxEveryPage
- มาโครจะสร้าง TextBox ในทุกหน้าของเอกสาร (ยกเว้นหน้าสุดท้าย) โดยดึงข้อความภาษาไทย 3 คำแรกจากหน้าถัดไป

3. เพิ่มปุ่มใน Toolbar (สำหรับ Word รุ่นเก่า):
- รันมาโคร AddMacroToToolbar
- ปุ่ม "สร้างข้อความต่อเนื่อง" จะปรากฏใน CommandBar "Standard" เพื่อให้เรียกใช้ CreateTextBoxEveryPage ได้สะดวก

4. ลบกล่องข้อความที่สร้างไว้:
- หากต้องการลบ TextBox ที่สร้างโดยมาโคร ให้รัน DeleteAllTextBox
- มาโครจะลบเฉพาะ TextBox ที่มี AlternativeText ว่า "NextPageTextBox"