顯示具有 Word & VBA 標籤的文章。 顯示所有文章
顯示具有 Word & VBA 標籤的文章。 顯示所有文章

2023年8月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
 

2023年8月25日 星期五

Word / 使用VBA分割word內的表格 番外 使用復原紀錄

Word / 使用VBA分割word內的表格 前2版的程式到最後都會關閉被分割的原始檔案

版本1因為又是程式碼存在的檔案，所以設計成把整個word關掉

版本2則是以不存檔的方式關閉檔案

想說有沒有比較好的方式

這次是嘗試用在編輯word內容常會用到的復原

不過如果直接用程式碼輸出 快速鍵 ctrl+z

復原的作用是在當下的VBE視窗，也就是復原程式碼的修改

後來爬到 Can I create an undo transaction in Word or Excel? (VSTO)

被打勾勾的最佳答案看起來是建立捕捉快速鍵的增益集

但是因為程式碼太長了，也搞不懂程式流程，於是放棄看完

不過其他人的回應提到

可以用 Application.UndoRecord object

比較接近我想要的方式，而且比較簡單

在測試的過程中，因為會切換不同檔案，所以復原紀錄不完整

一開始還不知道發生什麼事，爬文才知道如果跨文件的話，A文件不會記錄B文件的復原紀錄

而且自訂復原紀錄名稱似乎也會失效

StartCustomRecord does not work when making changes in two documents

If custom undo records are nested within other custom undo records, this property specifies what string appears on the undo stack after all custom undo actions have completed. If multiple calls to the StartCustomRecord method are nested, the string specified by the first call will be returned by this property. If no action is active, the property returns an empty string.

以版本1的程式碼進行修改

修改了關閉程式的部分

' 不存檔 關閉整個word程式Application.Quit SaveChanges:=wdDoNotSaveChanges

修改成復原動作

由於在VBA執行的檔案，只會紀錄到刪除表格列的動作

'復原動作ActiveDocument.Undo (u - 1)

所以在處理表格資料的迴圈開始之前，用變數u紀錄原始的表格列數

-1 是因為不會刪除第一列標題

 '紀錄表格初始列數u = mytable.Rows.Count

這樣的話不管有沒有存檔都沒差了

2023年8月23日 星期三

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

最近收到一個有審查意見的word檔

從內容看起來，老師應該是從excel複製貼上的

(圖示裡面的個資都是來自假文產生器，並不是實際檔案)

但是因為要分別給不同的人員

當然可以純手工分割這些表格(我一開始也是這樣)

不過由於這個過程還蠻規律的

1.複製第1列+第2列

2.開新檔案

3.用其中一個欄位的內容為檔案名稱

4.存檔

5.回到原檔案

6.刪掉第2列資料

7.然後再複製第1列 跟 新的第2列資料

重複1~6

所以在純手工之後，嘗試以VBA來處理這個流程

版本1，將原始檔案另存成docm 啟用巨集的格式，編輯與執行VBA

備註：因為程式是直接寫在檔案內，所以在測試時很容易忘記先存檔

然後最後就關閉檔案…

 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
Public Sub 表格分割()
    '取得工作檔案名稱
    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
    
    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
    
     MsgBox "完成，即將關閉檔案"
     
     '不存檔 關閉整個word程式
     Application.Quit SaveChanges:=wdDoNotSaveChanges
    
End Sub

 

版本2，新增一個docm檔案，將原始檔案作為資料來源

部分程式碼是取自 VBA / 使用Word VBA批次轉換成PDF

主要是修改”開始分割表格”的程式碼

備註：ActivaX按鈕的程式碼必須綁定按鈕，也就是程式碼是觸動事件要執行的內容，這在excel也是一樣的用法

(excel還多了2個可以設定執行程式的方式：1.用舊表單的按鈕、2.圖形，都可以指定巨集)

而且程式碼是寫在檔案本身(ThisDocument)，而不是在模組

  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
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
Private Sub cmdGO_Click()

    Application.ScreenUpdating = False
    
    Dim i As Integer, j As Integer, f As String, r As String
    
    i = 2
    j = 2
        
    'VBA程式所在的檔案資訊
    Dim FileName As String
    FileName = ActiveDocument.Name
    
    '取出表格內的檔案
    '檔案路徑
    f = Documents(FileName).Tables(1).Cell(i, 2).Range.Text
    '新增檔案命名的依據
    r = Documents(FileName).Tables(1).Cell(i, 3).Range.Text
    
    '去掉word表格內的非列印字元
    f = Left(f, Len(f) - 2)
    r = Left(r, Len(r) - 2)
    
    If f <> "" And r <> "" Then
        While f <> "" And i <= Documents(FileName).Tables(1).Rows.Count
           '檢查檔案是否存在
            If Dir(f) <> "" Then
                '開啟表格內的檔案
                Documents.Open FileName:=f
                
                '取得檔案名稱
                Dim workFile As String
                workFile = ActiveDocument.Name
                
                '取得邊界
                tbMargin = PointsToMillimeters(ActiveDocument.PageSetup.TopMargin)
                lrMargin = PointsToMillimeters(ActiveDocument.PageSetup.RightMargin)
                
                '設定工作資料夾
                '建立選擇目錄的對話方塊
                Dim fDialog As FileDialog
                
                Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
                
                fDialog.Filters.Clear
                
                fDialog.InitialFileName = ActiveDocument.Path & Application.PathSeparator
                
                If fDialog.Show Then
                    '顯示選擇的目錄
                    'MsgBox fDialog.SelectedItems(1)
                    ChangeFileOpenDirectory fDialog.SelectedItems(1)
                End If
                            
                Dim mytable As Table
                Set mytable = ActiveDocument.Tables(1)
               
                'Debug.Print mytable.Rows.Count
                
                ' for loop start
                Dim p As Integer
                
                For p = 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
                    
                    'Debug.Print ActiveDocument.Name
                    
                    '橫式頁面
                    If ActiveDocument.PageSetup.Orientation = wdOrientPortrait Then
                        ActiveDocument.PageSetup.Orientation = wdOrientLandscape
                    Else
                        ActiveDocument.PageSetup.Orientation = wdOrientPortrait
                    End If
                    
                    '設定邊界
                    ActiveDocument.PageSetup.TopMargin = MillimetersToPoints(tbMargin)
                    ActiveDocument.PageSetup.BottomMargin = MillimetersToPoints(tbMargin)
                    ActiveDocument.PageSetup.LeftMargin = MillimetersToPoints(lrMargin)
                    ActiveDocument.PageSetup.RightMargin = MillimetersToPoints(lrMargin)
                    
                    '使用在目的文件中所使用的樣式
                    Selection.PasteAndFormat (wdUseDestinationStylesRecovery)
                                    
                    '段落置中
                    'Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
                    
                    '指定的表格 在頁面置中 (所有資料列置中)
                    ActiveDocument.Tables(1).Rows.Alignment = wdAlignRowCenter
                                    
                    '取得儲存格資料 並移除特殊符號
                    Dim sName As String, nName As String
                    
                    Dim m As Integer
                    
                    '將數文字轉成數字
                    m = CInt(r)
                    
                    sName = ActiveDocument.Tables(1).Cell(2, m).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 p:
                'for loop end
                
                '將視窗切換到 工作檔案
                 Documents(workFile).Activate
                 
                 '關閉檔案 不儲存修改
                 ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
                    
            Else
                 MsgBox "檔案:" & f & "不存在，請查看是否有拼錯字"
            End If
            
            i = i + 1
            f = Documents(FileName).Tables(1).Cell(i, 2).Range.Text
            f = Left(f, Len(f) - 2)
            
            '釋放CPU資源 可以執行其他程序
            DoEvents
                    
        Wend
        
        MsgBox "執行完成"
        
    Else
        MsgBox "請確認表格資料是否完整!!"
        
    End If
        
    Application.ScreenUpdating = True
    
End Sub