丹哥的技術培養皿

A blogging framework for hackers.

法家論述

| Comments

法家曰: 人 性本惡 惡 人之本性 因人性有惡 才有法度 天下人生而好利 才有財貨土地之爭奪 生而貪欲 才有盜賊暴力與殺戮 生而有奢望 才有聲色犬馬 人性之惡 必以律法而後正 以法治防範惡慾 以法治疏導人性 人性才能向善有序

孟夫子空言性本善 將治世之功歸於人性之善 將亂世罪孽歸於法墨兵三家 無非是要重申仁政、人治與復古之論 回到夏商周三代 此乃縱容惡行 蒙蔽幼稚 真正的大偽之言

天下治道不在空談,而在力行 法治也好,人治也好 誰能融入大爭潮流而強國富民 誰便是正道 否則 便是空談大道貽誤天下 必將為大爭之世所遺棄

Job-Hunting in SIngapore

| Comments

第一次跨國找工作,我認為對於大部份的台灣受薪階級來說都是很新的領域。 誰沒事會想要離開土生土長的故鄉,千里迢迢的跑到其他國家去謀得一份餬口的工作呢? 通常,可能會納入考慮的國家及城市不外乎是:(中國)北京、上海、廣州、深圳、蘇州、杭州、重慶、成都 然後就是其他國家英語係國家了,如香港特區、新加坡。 去日本要會日文、去韓國要會韓文,更遑論薪資水準較低的越南、泰國、菲律賓、馬來西亞吉隆坡了,這些都不予考慮。

這次是以新加坡爲經驗。

要到新加坡工作第一件事情要認識到就是要有工作簽證,依據該國家的人力部 (Ministry of Manpower , 簡稱 MOM ) 工作簽證分為下列幾種:

資料來源:Ministry of Manpower 核發工作准証還是要依照 MOM 的審核,不完全只有依照薪資為唯一的判斷。

Professional Employment Pass P1 (簡稱 EP P1 ) :Fix Monthly Income 8000 SGD 新幣 以上 Employment Pass P2 (簡稱 EP P2 ) :Fix Monthly Income 4500 SGD 新幣 以上 Employment Pass Q1 (簡稱 EP Q1 ) :Fix Monthly Income 3000 SGD 新幣 以上 據說2014年開始 Q1 准証的最低要求還要繼續提高到 3300 SGD.

Mid-level skilled workers S Pass : Fix Monthly Income 2200 SGD 新幣以上

foreign unskilled workers. Work Pass : 基本上就是指勞動階層了,最大宗應該就是建築工人。這邊就不多討論了。

不同的工作准證所相對應搭配的是僱主要負擔的成本,以及勞工本身要替自己的配偶、家人申請滯留新加坡簽證時的不同規定以及要求水平。 細節的部分這邊就先不多做解釋了,畢竟申請工作准証還是要以 MOM 審核結果為主。

第二個部分就是,我到底要到哪邊找工作? 1. 可以先到新加坡政府官方網站上面列出了很多求職網站 http://www.contactsingapore.org.sg/find_a_job/jobs_overview/

其中比較大宗使用的是 http://www.jobstreet.com.sg/http://www.indeed.com.sg/ http://www.stjobs.sg/ http://www.monster.com.sg/index.html <- headhunter都在這邊看到我的履歷,進而打給我,而其他求職網站就沒有,不知道為啥。 以及 http://www.efinancialcareers.sg/ [金融產業職缺為主] 這幾個網站。

當大家在看這些求職網站的時候,及會發現有大量的 Recruitment Firm (人力資源公司),他們都代理著各大企業在找尋人才,由他們過濾、篩選,媒合求職者以及用人的僱主企業。 新加坡大大小小登記有案的人力資源公司非常的多,從國際型到小小的一間公司都有。 我接過三四通不同headhunter打電話過來聊,一定會問的問題就是 a) 再確認一次你過去工作的年資、及大略上扮演的角色跟責任是什麼 b) 你前一份工作的薪資是多少,請自行轉換為新加坡幣,以及你期望的薪資是多少 c) 為什麼你想要離開台灣?為什麼選擇跑到新加坡來工作? d) 問你是否有新加坡PR (Permanent Residence 永久居民) 身份、或新加坡公民身份。

最後就是談到,要準備好英文履歷(Resume or CV) 以及 Cover Letter 對台灣學生或職場上班族來說,以往找工作不外乎就是透過 104 , 1111, yes123 , etc 等等國內知名的求職網站 鮮少自行準備英文履歷表,更遑論撰寫過任何一封 Cover Letter. 但當我們踏出台灣之後,迎面而來的是歐美的文化,香港也是、新加坡也是,即便是在中國的外國企業(外企)也是; 這是人家找尋人才的一套規則,我們要順應它,適應它,克服它。 台灣人苦幹實幹,肯做願意做;但缺少的是包裝自己的能力,以及表達自己的能力,你我都應該花費時間去練習及琢磨才是。

想到再繼續更新….

多個EXCEL表的Worksheet (資料表頁籤),合併至一個檔案內不同的Worksheet(資料表頁籤)之VBA 程式碼 (合併多個檔案,步驟一)

| Comments

以下程式碼出處是來自於 彰化一整天的blog http://blog.bestdaylong.com/2008/07/excelcopy_31.html 再經過我自身需求的改寫所得出符合我需要的程式碼。

常常工作上可能會遇到需要把很多個同樣格式,但是不同檔案的EXCEL表合併起來,所以要做的動作有兩個: 1. 先把不同檔案的EXCEL表,每一個檔案裡面的第一個頁籤(worksheet)、工作表,自動複製到一個檔案內的不同頁籤 2. 接著再把一個檔案內的不同頁簽的資料再全部合併成同一個頁簽內即可。

請預先將excel表內的各欄位設計如下,程式碼會自動抓取 G欄位 內各項儲存格的內容,作為參數

muti_worksheet_to2.jpg

以下為第1步驟的程式碼

抓取資料夾檔名

1
2
3
4
5
6
7
8
9
10
11
12
13
WorkName = Excel.ActiveWorkbook.Name
MsgBox Excel.Workbooks(WorkName).Path

file_path = Excel.Workbooks(WorkName).Path


fs = Dir(file_path & "\*.*")
Do Until fs = ""
r = r + 1
y = 1
Cells(y + r, 2) = fs
fs = Dir
Loop

合併EXCEL檔案檔名

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
Dim objsheet As Worksheet


n = UCase(Range("G2"))
m = UCase(Range("G3"))
x = Range("G4")



WorkName = Excel.ActiveWorkbook.Name '此檔案名稱


Excel.Workbooks.Add '開新的workbook

desc = Excel.ActiveWorkbook.Name   '新檔案視窗編號
i = 2
While Windows(WorkName).ActiveSheet.Range("b" & i) <> ""
'    Filename = Windows(WorkName).ActiveSheet.Range("b" & i) & ".xlsx"
    Filename = Windows(WorkName).ActiveSheet.Range("b" & i) & "." & x
    Workbooks.Open Filename:=Excel.Workbooks(WorkName).Path & "\" & Filename    '開啟檔案
    Set objsheet = Windows(Filename).ActiveSheet '切換視窗

     '取消篩選
     ActiveSheet.AutoFilterMode = False


    '選取來源範圍
'     objsheet.Range("A1:AZ500").Select
      objsheet.Range(n & ":" & m).Select

     'copy
     Selection.Copy

    Windows(desc).Activate '切換視窗
    Sheets.Add  '增加活頁
    ActiveSheet.Paste   '貼上
    ActiveSheet.Range("A1").Select  '將選取範圍取消

    With ActiveSheet
        .Rows.RowHeight = 20
    End With

    ActiveSheet.Name = "No_" & (i - 1)


    'ActiveSheet.Name = Windows(WorkName).ActiveSheet.Range("b" & i)     '將活頁名稱改成檔案名稱


    '避免copy太多資料時,要關閉檔案時.會問記憶體的資料是否要保留
    ActiveSheet.Range("A1").Copy

   '將來源檔案關閉

   Workbooks(Filename).Saved = True
   Windows(Filename).Close

    i = i + 1 '讀取下一個檔案名稱
Wend
MsgBox "已將所有檔案匯入各項不同worksheet資料表頁籤中"

EXCEL內,多個Worksheet(資料表)合併為同一資料表的VBA 程式碼 (合併多個檔案,步驟二)

| Comments

以下程式碼出處是來自於 彰化一整天的blog http://blog.bestdaylong.com/2008/10/excel.html 再經過我自身需求的改寫所得出符合我需要的程式碼。

常常工作上可能會遇到需要把很多個同樣格式,但是不同檔案的EXCEL表合併起來,所以要做的動作有兩個: 1. 先把不同檔案的EXCEL表,每一個檔案裡面的第一個頁籤(worksheet)、工作表,自動複製到一個檔案內的不同頁籤 2. 接著再把一個檔案內的不同頁簽的資料再全部合併成同一個頁簽內即可。

請預先將excel表內的各欄位設計如下,程式碼會自動抓取B欄位內各項儲存格的內容,作為參數

muti_worksheet_to1.jpg

以下為第2步驟的程式碼

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
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
Dim a, b, c As Integer '宣告a,b,c為整數

Dim objsheet As Worksheet

Dim sheetname As String '工作表檔名

Dim ispastervalue As String '是否要選擇性貼上值及格式

Source = Excel.ActiveWorkbook.Name '新檔案視窗編號


n = Range("b3")
m = Range("b4")

x = Range("b5")
y = Range("b6")

display_sheetname = UCase(Range("b7"))
display_row_sheetname = UCase(Range("b8"))
insert_page = UCase(Range("b9"))
insert_row = Range("b10")
ispastervalue = UCase(Range("b11"))


 '將之前合併的結果清除
Sheet2.Cells.Delete Shift:=xlUp

z = 1
i = 1

Filename = Range("b" & i) & "." & Range("b2")

FullPath = Excel.Workbooks(Source).Path & "\" & Filename

'檢查檔案是否存在
If Dir(FullPath) = "" Then '檢查檔案是否存在
    MsgBox "檔案:" & FullPath & "不存在,請查看是否有拼錯字"
    Exit Sub
End If


Workbooks.Open Filename:=Excel.Workbooks(Source).Path & "\" & Filename

WorkName = Excel.ActiveWorkbook.Name '此檔案名稱

i = 12

sheetname = Trim(Windows(Source).ActiveSheet.Range("b" & i))


If sheetname = "" Then
   For j = 1 To Sheets.Count

        x = Range("b5")
        y = Range("b6")
       Windows(WorkName).Activate
       Set objsheet = Sheets(j) '切換視窗

       objsheet.Activate

        '讀取來源檔案的X(列數),Y(行數)
        If x = 0 Then
            x = n

            Do While True
                kk = ""
                For l = 1 To 10
                    For k = 1 To 10
                        If IsError(objsheet.Cells(x + l, k)) = False Then
                            kk = kk & objsheet.Cells(x + l, k)
                        End If
                    Next
                Next
                If kk = "" Then Exit Do
                x = x + 1
            Loop
        End If

        If y = 0 Then
              y = m

              Do While True
                  kk = ""
                  For l = 1 To 10
                      For k = 1 To 10
                          If IsError(objsheet.Cells(k, y + l)) = False Then
                              kk = kk & objsheet.Cells(k, y + l)
                          End If
                      Next
                  Next l
                  If kk = "" Then Exit Do
                  y = y + 1
              Loop
        End If

        '選取目的
        Windows(WorkName).Activate




        '選取來源範圍
         objsheet.Range(objsheet.Cells(n, m), objsheet.Cells(x, y)).Select

         'copy
         Selection.Copy

        Windows(Source).Activate

        Sheet2.Activate

        If (display_row_sheetname = "Y") Then
            If display_sheetname = "Y" Then
                Sheet2.Cells(z, 1) = objsheet.Name
                Sheet2.Cells(z, 2) = objsheet.Name
            Else
                Sheet2.Cells(z, 1) = objsheet.Name
            End If
            o = 1
        Else
            o = 0
        End If


        If display_sheetname = "Y" Then
           Sheet2.Cells(z + o, 2).Select
           For k = z To z + x - n + o
              Sheet2.Cells(k, 1) = objsheet.Name
           Next
        Else
           Sheet2.Cells(z + o, 1).Select
        End If

        If (z > 3 And insert_page = "Y") Then
            If display_row_sheetname = "Y" Then
                ActiveWindow.SelectedSheets.HPageBreaks.Add before:=ActiveCell.Offset(-1, 0)
            Else
                ActiveWindow.SelectedSheets.HPageBreaks.Add before:=ActiveCell
            End If

        End If


        If ispastervalue = "Y" Then
            Sheet2.Activate
            Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
    xlNone, SkipBlanks:=False, Transpose:=False
        Else
            ActiveSheet.Paste
        End If


        z = z + x - n + 1 + insert_row + o

       '將來源檔案關閉
       'Windows(Filename).Close

        i = i + 1 '讀取下一個檔案名稱

        Sheet1.Activate

   Next

Else
    While sheetname <> ""

       x = Range("b5")
       y = Range("b6")

       Windows(WorkName).Activate

       '檢查活頁是否存在
       isfind = False
       For Each st In Sheets
           If st.Name = sheetname Then
              isfind = True
              Exit For
           End If
       Next

       If isfind = False Then
           MsgBox "工作表:" & sheetname & "不存在,請查看是否有拼錯字"
           Exit Sub
       End If

       Set objsheet = Sheets(sheetname) '切換視窗

       objsheet.Activate

        '讀取來源檔案的X(列數),Y(行數)
        If x = 0 Then
            x = n

            Do While True
                kk = ""
                For l = 1 To 10
                    For k = 1 To 10
                        If IsError(objsheet.Cells(x + l, k)) = False Then
                            kk = kk & objsheet.Cells(x + l, k)
                        End If
                    Next
                Next
                If kk = "" Then Exit Do
                x = x + 1
            Loop
        End If

        If y = 0 Then
              y = m

              Do While True
                  kk = ""
                  For l = 1 To 10
                      For k = 1 To 10
                          If IsError(objsheet.Cells(k, y + l)) = False Then
                              kk = kk & objsheet.Cells(k, y + l)
                          End If
                      Next
                  Next l
                  If kk = "" Then Exit Do
                  y = y + 1
              Loop
        End If

        '選取目的
        Windows(WorkName).Activate

        '選取來源範圍
         objsheet.Range(objsheet.Cells(n, m), objsheet.Cells(x, y)).Select

         'copy
         Selection.Copy

        Windows(Source).Activate

        Sheet2.Activate

        If (display_row_sheetname = "Y") Then
            If display_sheetname = "Y" Then
                Sheet2.Cells(z, 1) = objsheet.Name
                Sheet2.Cells(z, 2) = objsheet.Name
            Else
                Sheet2.Cells(z, 1) = objsheet.Name
            End If
            o = 1
        Else
            o = 0
        End If


        If display_sheetname = "Y" Then
           Sheet2.Cells(z + o, 2).Select
           For k = z To z + x - n + o
              Sheet2.Cells(k, 1) = objsheet.Name
           Next
        Else
           Sheet2.Cells(z + o, 1).Select
        End If

        If (z > 3 And insert_page = "Y") Then
            If display_row_sheetname = "Y" Then
                ActiveWindow.SelectedSheets.HPageBreaks.Add before:=ActiveCell.Offset(-1, 0)
            Else
                ActiveWindow.SelectedSheets.HPageBreaks.Add before:=ActiveCell
            End If

        End If

        If ispastervalue = "Y" Then
            Sheet2.Activate
            Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
    xlNone, SkipBlanks:=False, Transpose:=False
        Else
            ActiveSheet.Paste
        End If
         z = z + x - n + 1 + insert_row + o

       '將來源檔案關閉
       'Windows(Filename).Close

        i = i + 1 '讀取下一個檔案名稱

        Sheet1.Activate

        sheetname = Windows(Source).ActiveSheet.Range("b" & i)

    Wend
End If
Windows(Source).Activate
Sheet2.Activate

  With ActiveSheet
  '.Columns.ColumnWidth = .StandardWidth
  .Rows.RowHeight = 20
  End With

Sheet2.Cells(1, 1).Select

'將來源檔案關閉
 Workbooks(Filename).Saved = True
 Windows(WorkName).Close

 MsgBox "合併完畢,請按底下[工作表]切換回設[參數設定]"

EXCEL 內容轉換至 Word 的程式碼

| Comments

嘔心瀝血到處蒐集拼湊出來的把 excel 內容,自動轉換貼到 word 表格的程式碼 我受夠了,一直MAINTAIN 兩份不同的檔案了阿。

VBA 裡面要先做一個動作,要去 include word 的函式庫進來 Step 1 , 先從VBA的選單 " 工具 " -> "設定引用項目" Step 2 , 按瀏覽 , 接著去路徑 C:\Program Files\Microsoft Office\Office12\

裡面會有一個 MSWORD.OLB的檔案 ,再按確定就可以引用完成了。

sample.jpg

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
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
Sub transfer()

'宣告指向 Microsoft Word 文件的變數
Dim appWD As Word.Application

Set appWD = Nothing  '使用完後將appWD變數釋放掉,避免佔用記憶體


'在其他應用程式中,使用要處理物件的 OLE 程式識別符號 作為 CreateObject 函數,
Set appWD = CreateObject("Word.Application")

'如果要檢視其他應用程式的階段作業,請將 Visible 屬性設定為 True。
appWD.Visible = True
appWD.Documents.Add


' 設定word 版面為橫版面

appWD.ActiveDocument.PageSetup.Orientation = wdOrientLandscape


'填入指定格式的文字並而後新增空白段落

appWD.Selection.Font.Size = 22
appWD.Selection.Font.Bold = True
appWD.Selection.TypeText ("Excel 2 Word")  '插入指定的文字
appWD.Selection.TypeParagraph  '插入一個新的空白段落

'複製Excel儲存格某範圍至word檔 -- 評估原則一

appWD.Selection.Font.Size = 16
appWD.Selection.TypeText ("評估原則一、保護標的與生命循環")  '插入指定的文字

Range("C2:H5").Copy
appWD.Selection.Paste
appWD.Selection.TypeParagraph
'appWD.Selection.TypeText ("測試這列文字停在哪邊第一段結束")  '插入指定的文字
appWD.Selection.TypeParagraph

'複製Excel儲存格某範圍至word檔  -- 評估原則二

appWD.Selection.Font.Size = 16
appWD.Selection.TypeText ("評估原則二、預防損害原則")  '插入指定的文字

Range("C6:H12").Copy
appWD.Selection.Paste
appWD.Selection.TypeParagraph
'appWD.Selection.TypeText ("測試這列文字停在哪邊第二段結束")  '插入指定的文字
appWD.Selection.TypeParagraph

'複製Excel儲存格某範圍至word檔  -- 評估原則三

appWD.Selection.Font.Size = 16
appWD.Selection.TypeText ("評估原則三、告知原則")  '插入指定的文字

Range("C19:H26").Copy
appWD.Selection.Paste
appWD.Selection.TypeParagraph
'appWD.Selection.TypeText ("測試這列文字停在哪邊第三段結束")  '插入指定的文字
appWD.Selection.TypeParagraph

'複製Excel儲存格某範圍至word檔  -- 評估原則四

appWD.Selection.Font.Size = 16
appWD.Selection.TypeText ("評估原則四、蒐集限制原則")  '插入指定的文字

Range("C27:H32").Copy
appWD.Selection.Paste
appWD.Selection.TypeParagraph
'appWD.Selection.TypeText ("測試這列文字停在哪邊第四段結束")  '插入指定的文字
appWD.Selection.TypeParagraph

'複製Excel儲存格某範圍至word檔  -- 評估原則五

appWD.Selection.Font.Size = 16
appWD.Selection.TypeText ("評估原則五、個人資料利用原則")  '插入指定的文字

Range("C33:H36").Copy
appWD.Selection.Paste
appWD.Selection.TypeParagraph
'appWD.Selection.TypeText ("測試這列文字停在哪邊第五段結束")  '插入指定的文字
appWD.Selection.TypeParagraph

'複製Excel儲存格某範圍至word檔  -- 評估原則六

appWD.Selection.Font.Size = 16
appWD.Selection.TypeText ("評估原則六、當事人自主原則及查閱及更正原則")  '插入指定的文字

Range("C37:H39").Copy
appWD.Selection.Paste
appWD.Selection.TypeParagraph
'appWD.Selection.TypeText ("測試這列文字停在哪邊第六段結束")  '插入指定的文字
appWD.Selection.TypeParagraph

'複製Excel儲存格某範圍至word檔  -- 評估原則七

appWD.Selection.Font.Size = 16
appWD.Selection.TypeText ("評估原則七、個人資料完整性原則")  '插入指定的文字

Range("C40:H42").Copy
appWD.Selection.Paste
appWD.Selection.TypeParagraph
'appWD.Selection.TypeText ("測試這列文字停在哪邊第七段結束")  '插入指定的文字
appWD.Selection.TypeParagraph

'複製Excel儲存格某範圍至word檔  -- 評估原則八

appWD.Selection.Font.Size = 16
appWD.Selection.TypeText ("評估原則八、安全管理原則")  '插入指定的文字

Range("C43:H70").Copy
appWD.Selection.Paste
appWD.Selection.TypeParagraph
'appWD.Selection.TypeText ("測試這列文字停在哪邊第八段結束")  '插入指定的文字
appWD.Selection.TypeParagraph

'複製Excel儲存格某範圍至word檔  -- 評估原則九

appWD.Selection.Font.Size = 16
appWD.Selection.TypeText ("評估原則九、責任原則")  '插入指定的文字

Range("C71:H79").Copy
appWD.Selection.Paste
appWD.Selection.TypeParagraph
'appWD.Selection.TypeText ("測試這列文字停在哪邊第九段結束")  '插入指定的文字
appWD.Selection.TypeParagraph

For i = 1 To 9

' 設定每一欄位的固定寬度,先至 word  量測過後,再回來調整這邊的數據, 單位是公分

appWD.ActiveDocument.Tables(i).Columns(1).Width = CentimetersToPoints(2)
appWD.ActiveDocument.Tables(i).Columns(2).Width = CentimetersToPoints(3.5)
appWD.ActiveDocument.Tables(i).Columns(3).Width = CentimetersToPoints(8)
appWD.ActiveDocument.Tables(i).Columns(4).Width = CentimetersToPoints(8)
appWD.ActiveDocument.Tables(i).Columns(5).Width = CentimetersToPoints(2)
appWD.ActiveDocument.Tables(i).Columns(6).Width = CentimetersToPoints(2)


'需設定每個table 裡面的  row 可以跨分頁
appWD.ActiveDocument.Tables(i).Rows.AllowBreakAcrossPages = True

   ' 網路上找來的解法 : 設定每個table 的第一列為標題列,必須重複
    Dim oTable As Table
    Dim oCell As Cell
    Set oTable = appWD.ActiveDocument.Tables(i)
    For Each oCell In oTable.Range.Cells
    If oCell.Range.Information(wdEndOfRangeRowNumber) = 1 Then
    oCell.Range.Rows.HeadingFormat = True
    End If
    Next
    Set oCell = Nothing
    Set oTable = Nothing


appWD.ActiveDocument.Tables(i).Select

'所有段落統一靠左
appWD.Selection.Paragraphs.Alignment = wdAlignParagraphLeft


'所有段落設定為最小行高

appWD.Selection.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
appWD.Selection.ParagraphFormat.LineSpacing = 21

Next i

'複製Excel圖表至word檔
'ActiveSheet.ChartObjects("圖表 2").Activate
'ActiveChart.ChartArea.Select
'ActiveChart.ChartArea.Copy
'appWD.Selection.PasteAndFormat (wdChartPicture)

Set appWD = Nothing  '使用完後將appWD變數釋放掉,避免佔用記憶體

MsgBox (" Copy to Word is done ")
'
End Sub