Excel工作表繁簡轉換增益集

by chijanzen on 八月 19th, 2008 | View: 8,202 views

Tags

TCSCConverter

Comments (11)

索引	H0067
主題	Excel工作表繁簡轉換增益集
版本	>= 9.0(Office 2000)
說明	本範例調用 Word 中 TCSCConverter 方法來進行工作表中文字的繁簡轉換。這個功能類似微軟的 Office 2003 簡繁轉換增益集，各位可以去下載。會做這一個程式是因為幾年前我寫不出來，今天寫出來了還真是爽。下一個目標是將VBA程式碼繁簡轉換，敬請期待...
參考

Code

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.CommandBars("Standard").Controls("cmd_TCSC").Delete
Application.CommandBars("Standard").Controls("cmd_SCTC").Delete
End Sub
　

Private Sub Workbook_Open()
On Error Resume Next
Dim TCSCButton As CommandBarButton
Application.CommandBars("Standard").Controls("cmd_TCSC").Delete
Application.CommandBars("Standard").Controls("cmd_SCTC").Delete
Set Std_Bar = Application.CommandBars("Standard")
Set TCSC_Button = Std_Bar.Controls.Add(Type:=msoControlButton, Temporary:=True)
With TCSC_Button
    .Caption = "cmd_TCSC"
    .OnAction = "xls_TCSCConverter"
    ThisWorkbook.Sheets("Sheet2").Shapes("TCSC").Copy
    .PasteFace
    .Style = msoButtonIcon
    .TooltipText = "繁轉簡"
End With
Set TCSC_Button = Std_Bar.Controls.Add(Type:=msoControlButton, Temporary:=True)
With TCSC_Button
    .Caption = "cmd_SCTC"
    .OnAction = "xls_SCTCConverter"
    ThisWorkbook.Sheets("Sheet2").Shapes("SCTC").Copy
    .PasteFace
    .Style = msoButtonIcon
    .TooltipText = "簡轉繁"
End With
End Sub
　

Code

Dim wrdApp As Object
　

Sub xls_TCSCConverter()
Dim All_Rng As Range
Dim crng As Range
Dim strData As String
'預防儲存格都沒有資料時的處理
If Application.CountA(ActiveSheet.Cells) = 0 Then Exit Sub
Set wrdApp = CreateObject("Word.Document")
'取得Sheet中有資料的Range 集合
Set All_Rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, 2)
'關掉螢幕更新
Application.ScreenUpdating = False
For Each crng In All_Rng
    If Len(crng) > 0 Then
        '1 繁轉簡  0 簡轉繁
        crng = T_S_Cvt(crng, 1)
    End If
Next crng
Application.ScreenUpdating = True
wrdApp.Close False
End Sub
　

Sub xls_SCTCConverter()
Dim All_Rng As Range
Dim crng As Range
Dim strData As String
'預防儲存格都沒有資料時的處理
If Application.CountA(ActiveSheet.Cells) = 0 Then Exit Sub
Set wrdApp = CreateObject("Word.Document")
'取得Sheet中有資料的Range 集合
Set All_Rng = ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, 2)
'關掉螢幕更新
Application.ScreenUpdating = False
For Each crng In All_Rng
    If Len(crng) > 0 Then
        '1 繁轉簡  0 簡轉繁
        crng = T_S_Cvt(crng, 0)
    End If
Next crng
Application.ScreenUpdating = True
wrdApp.Close False
End Sub
　

Public Function T_S_Cvt(strData, bytOption) As String
With wrdApp
    .Content = strData
    '調用Word TCSCConverter 方法來轉換繁簡體
    .Range.TCSCConverter bytOption, True, True
    T_S_Cvt = .Content
End With
End Function
　

Help

Code

檔案請解壓縮到同一資料夾中，請執行 InstallAddin.xls 檔案安裝增益集

DownLoad

Code

Popularity: 18%

About the Author

網路化名: chijanzen、中國龍、邪兵衛經歷: 第二屆微軟社群之星第三屆微軟「最有價值專家」第五屆微軟「最有價值專家」

Leave a Comment »11 Comments

Reply » chijanzen 六月 26, 2009

lily:
已經有人開發了，請看
http://chijanzen.net/wp/?p=177
Reply » lily 六月 19, 2009

請問你下一個目標是說要用vba的程式碼來做excel簡繁體的轉換嗎?
因為最近工作上需用到這個
但自己試了一下用excel巨集做....都沒看到簡繁體的vba程式碼
謝謝您
Reply » afwebreg 二月 28, 2009

Thank you so much. The tool is very helpful and makes my life much easier.
Reply » 雨十一月 13, 2008

能否也寫個給OpenOffice用的
Reply » Stephen 十月 28, 2008

太好了, 多謝.
Reply » chijanzen 十月 25, 2008

Stephen 你好:
已修正完成，請至 H0067a 下載
Reply » Stephen 十月 25, 2008

好啊, 謝謝.
Reply » chijanzen 十月 22, 2008

你好:
可以做到只轉換你選取的儲存格(例如A1:A10,....)，這樣可以嗎?
如果可以我就來改版一下
Reply » Stephen 十月 22, 2008

chijanzen,
你提供的程式比微軟還好用, 謝謝 !
但每次都是整張 work sheet 轉換, 可否像 Microsoft word 的, 由自己決定轉換那些字.
Reply » chijanzen 九月 12, 2008

你好:
請問你是下載微軟的 Office 2003 簡繁轉換增益集不能安裝嗎?
還是我提供的檔案不能執行，其實我提供的程式碼是不用引用word 11.0 的object library
Reply » KY Liu 九月 12, 2008

大哥您好，
下載後，無法安裝，會提示要先裝 excel 2003 ,
但是我已經確定我是 excel 2003 了，
請問有沒有別的方式呢?
我另外有引用了word 11.0 的object library .
想要用 word 的library 做轉換，
但是也沒法使用，請問您能不能教我一下。
謝謝

Get a GravatarLeave a Reply

Blue Green Grey Orange Purple Red

chijanzen 雜貨舖

Excel工作表繁簡轉換增益集

Help

DownLoad