Sub 利用VBA實現Word文件的拆分()On Error Resume NextDim doc1 As Document, newdoc As Document, a, page1%, page2%, i1%, i2%, i3%, dk As FileDialog, b$Dim doc2 As DocumentDim zb, yb, sb, xba = InputBox("請輸入分割頁數（預設每隔1頁分割一次）", , 1)If a <> "" Then    d = MsgBox("請選擇拆分文件的儲存路徑", 1 + 64)    If d = 1 Then        Set dk = Application.FileDialog(msoFileDialogFolderPicker)        If dk.Show = -1 Then            Set doc1 = ActiveDocument            page1 = doc1.Content.Information(wdNumberOfPagesInDocument)            doc1.Content.Select            Selection.Collapse 1            For i1 = 1 To page1 Step a                If i1 + a > page1 Then                    i2 = page1                    If a = 1 Then                        b = "_" & "第" & i2 & "頁"                    Else                        If page1 Mod a = 1 Then                         b = "_" & "第" & i2 & "頁"                         Else                            If i1 + a - 1 = page1 Then                            b = "_" & "第" & i1 & "-" & i2 & "頁"                            Else                            b = "_" & "第" & (page1 - page1 Mod a) + 1 & "-" & page1 & "頁"                            End If                        End If                    End If                Else                i2 = i1 + a - 1                    If a = 1 Then                        b = "_" & "第" & i1 & "頁"                    Else                        b = "_" & "第" & i1 & "-" & i2 & "頁"                    End If                End If                Set newdoc = Documents.Add                For i3 = i1 To i2                    doc1.Activate                    doc1.Bookmarks("\page").Range.Copy                    With Selection.PageSetup                    zb = .LeftMargin                    yb = .RightMargin                    sb = .TopMargin                    xb = .BottomMargin                    End With                    Application.Browser.Target = wdBrowsePage                    Application.Browser.Next                    newdoc.Activate                    Selection.Paste                    With Selection.PageSetup                    .LeftMargin = zb                    .RightMargin = yb                    .TopMargin = sb                    .BottomMargin = xb                    End With                Next                newdoc.SaveAs2 (dk.SelectedItems(1) & "\" & Split(doc1.Name, ".doc")(0) & b & ".docx")                newdoc.Close -1            Next        MsgBox "拆分完成" & Chr(13) _        & Chr(13) _        & "已儲存至" & dk.SelectedItems(1), 0 + 64        End If    End IfEnd IfEnd Sub