[word] script

'''''''''''''''''''''''''
' 請開啟「大綱檢視模式」（View > Outline）以確保段落階層正確識別
'''''''''''''''''''''''''

Sub 取得所有段落()
    Dim para As Paragraph
    Dim i As Integer

    i = 1
    For Each para In ActiveDocument.Paragraphs
        Debug.Print "段落 " & i & ": " & para.Range.Text
        i = i + 1
    Next para
End Sub

Sub 將段落寫入文字檔()
    Dim para As Paragraph
    Dim i As Integer
    Dim filePath As String
    Dim fileNum As Integer

    ' 設定輸出檔案路徑（這裡以桌面為例）
    filePath = Environ("USERPROFILE") & "\Desktop\段落輸出.txt"

    ' 取得可用的檔案編號
    fileNum = FreeFile

    ' 開啟文字檔做為輸出
    Open filePath For Output As #fileNum

    ' 逐段寫入
    i = 1
    For Each para In ActiveDocument.Paragraphs
        Print #fileNum, "段落 " & i & ": " & para.Range.Text
        i = i + 1
    Next para

    ' 關閉檔案
    Close #fileNum

    MsgBox "段落已寫入：" & filePath
End Sub

Sub 將段落寫入文字檔_含大綱_含樣式()
    Dim para As Paragraph
    Dim i As Integer
    Dim filePath As String
    Dim fileNum As Integer
    Dim styleName As String
    Dim styleLabel As String

    ' 設定輸出檔案路徑（這裡以桌面為例）
    filePath = Environ("USERPROFILE") & "\Desktop\段落輸出_含大綱_含樣式.txt"

    ' 取得可用的檔案編號
    fileNum = FreeFile

    ' 開啟文字檔做為輸出
    Open filePath For Output As #fileNum

    ' 逐段寫入
    i = 1
    For Each para In ActiveDocument.Paragraphs
        With para
            ' 取得大綱階層（1~9）或正文
            If .outlineLevel >= 1 And .outlineLevel <= 9 Then
                outlineLevel = "階層 " & .outlineLevel
            Else
                outlineLevel = "本文"
            End If

            ' 輸出
            Print #fileNum, "段落 " & i & " [" & outlineLevel & "][" & .Style & "]: " & Trim(.Range.Text)
        End With
        i = i + 1
    Next para

    ' 關閉檔案
    Close #fileNum

    MsgBox "段落已寫入：" & filePath
End Sub

Sub 將段落寫入文字檔_僅限階層1至9()
    Dim para As Paragraph
    Dim i As Integer
    Dim filePath As String
    Dim fileNum As Integer
    Dim outlineLevel As String

    ' 設定輸出檔案路徑（以桌面為例）
    filePath = Environ("USERPROFILE") & "\Desktop\段落輸出_只含階層1至9.txt"
    fileNum = FreeFile
    Open filePath For Output As #fileNum

    i = 1
    For Each para In ActiveDocument.Paragraphs
        With para
            ' 只處理大綱階層 1 到 9 的段落
            If .outlineLevel >= 1 And .outlineLevel <= 9 Then
                outlineLevel = "階層 " & .outlineLevel

                ' 輸出
                Print #fileNum, "段落 " & i & " [" & outlineLevel & "][" & .Style & "]: " & Trim(.Range.Text)
            End If
        End With
        i = i + 1
    Next para

    Close #fileNum

    MsgBox "只含階層 1~9 的段落已寫入：" & filePath
End Sub

Sub 在指定範圍插入段落_含文字()
    Dim para2 As Paragraph
    Dim newPara As Paragraph

    ' 取得第二段
    Set para2 = ActiveDocument.Paragraphs(2)

    ' 在第二段前插入新段落
    para2.Range.InsertParagraphBefore

    ' 取得新插入的段落（para2 前一段）
    Set newPara = para2.Previous

    ' 填入文字，最後加上 vbCrLf 確保換行
    newPara.Range.Text = "hello world" & vbCrLf
End Sub

Sub 在指定範圍插入段落_含表格()
    Dim para2 As Paragraph
    Dim newPara As Paragraph
    Dim tbl As Table

    ' 取得第二段
    Set para2 = ActiveDocument.Paragraphs(2)

    ' 在第二段前插入新段落
    para2.Range.InsertParagraphBefore

    ' 取得新插入的段落（para2 前一段）
    Set newPara = para2.Previous

    ' 在 rng 位置插入一個 3 列 4 欄的表格
    Set tbl = ActiveDocument.Tables.Add(Range:=newPara.Range, NumRows:=3, NumColumns:=4)

    ' 填入第一格的文字
    tbl.Cell(1, 1).Range.Text = "第一列第一欄"

    ' 調整表格邊框樣式（可選）
    tbl.Borders.Enable = True
End Sub

Sub 複製指定階層1內容到指定段落()
    Dim para As Paragraph
    Dim startPara As Paragraph
    Dim endPara As Paragraph
    Dim i As Integer
    Dim h1Count As Integer
    Dim copyRange As Range
    Dim insertPara As Paragraph
    
    h1Count = 0
    i = 1

    ' 找出第 2 個階層 1 的段落作為起始點
    For Each para In ActiveDocument.Paragraphs
        If para.outlineLevel = wdOutlineLevel1 Then
            h1Count = h1Count + 1
            If h1Count = 2 Then
                Set startPara = para
            ElseIf h1Count = 3 Then
                Set endPara = para
                Exit For
            End If
        End If
    Next para

    If startPara Is Nothing Then
        MsgBox "找不到第 2 個階層 1 段落"
        Exit Sub
    End If

    ' 如果沒有第 3 個階層 1，則複製到文件結尾
    If endPara Is Nothing Then
        Set copyRange = ActiveDocument.Range(Start:=startPara.Range.Start, End:=ActiveDocument.Content.End)
    Else
        Set copyRange = ActiveDocument.Range(Start:=startPara.Range.Start, End:=endPara.Range.Start)
    End If

    ' 指定插入點（這裡以第 5 段為例）
    Set insertPara = ActiveDocument.Paragraphs(5)
    insertPara.Range.InsertParagraphBefore
    insertPara.Previous.Range.FormattedText = copyRange.FormattedText

    MsgBox "複製完成！"
End Sub