嚼的絮絮叨叨

因為工作的關系，我會需要用到「合併列印」的功能，通常我都是從Excel表中把資料抓出來…但在Excel上，資料的排序，會影晌到合併列印的結果，細說如下。

資料表中，假設一個廠商，擁有十台機器的編號，在Excel當中，表格如下key in

但我在Word當中要做出如下的合併資料：

因為只有做出這樣的表格，合併列印才能正常執行，不然該印給A廠商４張資料時，運用原始表格，只能抓到2006/4/21,A,AAAAAAAA,01,02,03,04；

所以運用Word的「文字轉表格」「表格轉文字」，再配合「取代」功能，將”,”視為取代對像，再用轉表格功能，將符合取代條件的資料進行轉換，就可以做出我要的資料表。

如果沒有這項功能，以前得自己手動換行，如果有20家廠商，200台機器，就得自己手動新增出80列出來…不死掉才怪，現在用巨集功能自動新增80列的資料…爽呀…哈哈哈！！

Button1是轉換鍵
Button2是清除表格
Button3是複製表格

但還是有缺點，轉換完成的表可以將機號拆開成行排列好，也就是
【000123;000456;000789】
會變成
【000123】
【000456】
【000789】


↓↓↓↓


從橫的變成直的。
不過，只有機號是變成直的，前面的基本資料無法隨著機號的垂直排列而變化，
(因為需要用VBA做精確的重複複製動作，這個我不會寫。。。)
所以還得使用Excel的【自動完成】功能才能補齊要的資料。

好！繼續加油，研讀VBA！！！

Private Sub CommandButton1_Click()
'
' 終極 巨集
' 巨集錄製於 2006/4/13，錄製者 user
'
    On Error Resume Next
    Selection.HomeKey Unit:=wdStory

'將機號後的分隔做整齊化
'清除全、半形空白：
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "　"
        .Replacement.Text = ""
'        .Forward = True
'        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = " "
        .Replacement.Text = ""
'        .Forward = True
'        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With

'
'清除奇怪的分隔符號 ；、，＼／\/ . ,
'

    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ","
        .Replacement.Text = ";"
'        .Forward = True
'        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
   
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "."
        .Replacement.Text = ";"
'        .Forward = True
'        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
   
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "；"
        .Replacement.Text = ";"
'        .Forward = True
'        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "、"
        .Replacement.Text = ";"
'        .Forward = True
'        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "／"
        .Replacement.Text = ";"
'        .Forward = True
'        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "＼"
        .Replacement.Text = ";"
'        .Forward = True
'        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
        Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "/"
        .Replacement.Text = ";"
'        .Forward = True
'        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
        Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "\"
        .Replacement.Text = ";"
'        .Forward = True
'        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
        Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "，"
        .Replacement.Text = ";"
'        .Forward = True
'        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With

'
'處理例外狀況
'
        Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "s;n"
        .Replacement.Text = "S/N　"
'        .Forward = True
'        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "碼;僅"
        .Replacement.Text = "碼，僅"
'        .Forward = True
'        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
 Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "家;點"
        .Replacement.Text = "家/點"
'        .Forward = True
'        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
 Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "家;金"
        .Replacement.Text = "家/金"
'        .Forward = True
'        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
 Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "嗓;點"
        .Replacement.Text = "嗓/點"
'        .Forward = True
'        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
 Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "霸;金"
        .Replacement.Text = "霸/金"
'        .Forward = True
'        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
 Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "華;啟"
        .Replacement.Text = "華/啟"
'        .Forward = True
'        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
 Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "航;音"
        .Replacement.Text = "航/音"
'        .Forward = True
'        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
 Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "霸;美"
        .Replacement.Text = "霸/美"
'        .Forward = True
'        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With


'開始做轉換

    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Rows.ConvertToText Separator:=wdSeparateByCommas, NestedTables:= _
        True

    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ";"
        .Replacement.Text = "^p,,,,,,"
'        .Forward = True
'        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.ConvertToTable Separator:=wdSeparateByCommas, NumColumns:=7, _
        NumRows:=91, Format:=wdTableFormatNone, ApplyBorders:=True, ApplyShading _
        :=True, ApplyFont:=True, ApplyColor:=True, ApplyHeadingRows:=True, _
        ApplyLastRow:=False, ApplyFirstColumn:=True, ApplyLastColumn:=False, _
        AutoFit:=True, AutoFitBehavior:=wdAutoFitFixed
    ActiveWindow.ActivePane.HorizontalPercentScrolled = 0
    Selection.Copy
   
   If Err.Number 0 Then         '測試錯誤
        'MsgBox Err.Description      '顯示錯誤訊息
        Err.Clear               '清除錯誤碼
        Else
        MsgBox "轉換且複製完成!"
    End If
   
Selection.HomeKey Unit:=wdStory
End Sub

Private Sub CommandButton2_Click()
    '
' 清除表格
' 巨集錄製於 2006/4/13，錄製者 user
On Error Resume Next
'        Selection.Tables(1).Select
        Selection.Tables(1).Delete
    If Err.Number 0 Then         '測試錯誤
        'MsgBox Err.Description      '顯示錯誤訊息
        Err.Clear               '清除錯誤碼
    End If
Selection.HomeKey Unit:=wdStory
End Sub

Private Sub CommandButton3_Click()
'
' 複製表格
' 巨集錄製於 2006/4/13，錄製者 user
'
On Error Resume Next
    Selection.HomeKey Unit:=wdStory
    Selection.Tables(1).Select
    Selection.Copy
    If Err.Number 0 Then         '測試錯誤
        'MsgBox Err.Description      '顯示錯誤訊息
        Err.Clear               '清除錯誤碼
   End If
End Sub