Word / 使用VBA分割word內的表格 番外2 使用書籤

Word / 使用VBA分割word內的表格 番外2 使用書籤

Post Views: 2,514

在 Word / 使用VBA分割word內的表格 番外

使用word的復原動作來回覆檔案編輯

回覆的次數是計算編輯次數，也就是程式迴圈數

不過缺點是如果一次迴圈內進行的編輯不只一次

這樣迴圈數就不等於編輯次數

後來仔細研究 Can I create an undo transaction in Word or Excel? (VSTO)的程式碼

Sub EditUndo()、Sub EditRedo()、Sub SampleUsage()、Function SetCustomProp()

總共有3個sub、1個function，發覺沒有想像中的複雜

因為程式碼最長的 Function SetCustomProp()其實應該用不到，或者我不知道有什麼作用

Sub EditUndo()跟 Sub EditRedo() 就是自訂的復原動作、取消復原動作

原作者的用意好像是要透過VSTO來取代內建的快捷鍵

Sub SampleUsage()是範例

程式的流程：在要開始紀錄的地方建立書籤；當處理程序結束之後，再移除書籤

這樣執行的處理就被 增加書籤——刪除書籤，這兩個動作包起來

而在 Sub EditUndo() 使用 Do Loop While語句

先執行一個判斷，雖然我也不知道這是在判斷什麼，大概是配合Function SetCustomProp()

微妙的地方在於

Loop While (ActiveDocument.Undo) And ActiveDocument.Bookmarks.Exists(BM_IN_MACRO)

會先執行 ActiveDocument.Undo ，再回傳值 True

也因為先執行了 ActiveDocument.Undo ，回復了刪除書籤的動作

這樣ActiveDocument.Bookmarks.Exists(BM_IN_MACRO) 也變成True

所以兩個條件都是True，這樣就可以再進入 Do Loop While

直到 執行 ActiveDocument.Undo 復原建立書籤，也就是沒有書籤了

於是ActiveDocument.Bookmarks.Exists(BM_IN_MACRO) 變成了False

這樣就會結束Do Loop While

Sub EditREdo()也是類似的流程，判斷的依據為是否存在取消復原動作

ActiveDocument.Redo = True

只是不知道我這樣的理解有沒有錯誤

所以依照這樣的流程修改了原來的程式

在迴圈之前，清除已有的復原紀錄，再建立書籤 BM_IN_MACRO

 '清除已有的復原動作
ActiveDocument.UndoClear
'建立書籤 
ActiveDocument.Range.Bookmarks.Add "BM_IN_MACRO"

在迴圈之後，移除自訂的書籤 BM_IN_MACRO

ActiveDocument.Bookmarks("BM_IN_MACRO").Delete

然後進入 Do Loop While

先執行 ActiveDocument.Undo，再判斷書籤是否存在

由於Undo回復的第一個動作就是刪除書籤，復原刪除=沒有刪除，所以書籤是存在的(True)

這樣就會重複Do Loop While，直到復原的動作進行到建立書籤，復原建立=沒有建立=False

Do 
    ActiveDocument.Undo 
Loop While ActiveDocument.Bookmarks.Exists("BM_IN_MACRO")

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
 
Public Sub 表格分割3()

    Application.ScreenUpdating = False
    
    '取得工作檔案名稱
    Dim workFile As String
    workFile = ActiveDocument.Name
    pathFile = ActiveDocument.Path & Application.PathSeparator & ActiveDocument.Name
    
    '指定文件夾
    'ChangeFileOpenDirectory "C:\Users\edu\Documents\"
    Dim fDialog As FileDialog
    
    ' 建立選擇目錄的對話方塊
    Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    
    If fDialog.Show Then
    ' 顯示選擇的目錄
        'MsgBox fDialog.SelectedItems(1)
        ChangeFileOpenDirectory fDialog.SelectedItems(1)
    End If

    'ActiveDocument.Tables(1).Select
    Dim mytable As Table
    Set mytable = ActiveDocument.Tables(1)
   
    'Debug.Print mytable.Rows.Count
    
    ' for loop start
    Dim i As Integer
    Dim u As Integer
    
    '紀錄表格初始列數
    u = mytable.Rows.Count
    
    '清除已有的復原動作
    ActiveDocument.UndoClear
    
    '建立書籤
    ActiveDocument.Range.Bookmarks.Add "BM_IN_MACRO"
    
    For i = 2 To mytable.Rows.Count
        ActiveDocument.Range(mytable.Rows(1).Range.Start, mytable.Rows(2).Range.End).Select
        
        Selection.Copy
        
        '新增檔案
        Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
        
        '橫式頁面
        If ActiveDocument.PageSetup.Orientation = wdOrientPortrait Then
            ActiveDocument.PageSetup.Orientation = wdOrientLandscape
        Else
            ActiveDocument.PageSetup.Orientation = wdOrientPortrait
        End If
        
        '使用在目的文件中所使用的樣式
        Selection.PasteAndFormat (wdUseDestinationStylesRecovery)
        
        'Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
        
        '指定的表格 在頁面置中
        ActiveDocument.Tables(1).Rows.Alignment = wdAlignRowCenter
        
        '取得儲存格資料 並移除特殊符號
        Dim sName As String
        Dim nName As String
        
        sName = ActiveDocument.Tables(1).Cell(2, 1).Range.Text
        
        '移除表格儲存格最後面的2個特殊符號 ASCII 13 Carriage Return, ASCII 7 Bell
        nName = Left(sName, Len(sName) - 2)
        
        'Debug.Print nName
        'Debug.Print Len(nName)
        
        ActiveDocument.SaveAs2 FileName:=nName & ".docx"
                
        ActiveDocument.Close
        
        '將視窗切換到 工作檔案
        Documents(workFile).Activate
                    
        '刪除表格的第2列資料
        ActiveDocument.Tables(1).Rows(2).Delete
        
     Next i:
    'for loop end
    
    '復原動作
    '移除書籤
    ActiveDocument.Bookmarks("BM_IN_MACRO").Delete
    
    Do
        ActiveDocument.Undo

    Loop While ActiveDocument.Bookmarks.Exists("BM_IN_MACRO")
    
    'Debug.Print ActiveDocument.Bookmarks.Exists("BM_IN_MACRO")
    
    Application.ScreenUpdating = True
        
End Sub