2023/08/31

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

在 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
 

0 comments:

張貼留言

訂閱： 張貼留言 (Atom)