轉自：http://www.officefans.net/cdb/viewthread.php?tid=52631

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By [email protected] 2007-2-14 17:44:46
'僅測試於System: Windows NT Word: 11.0 Language: 2052
'№ 0155^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－Option Explicit
Sub GetChineseNum2()
'修正了原資料中含有千分位分隔符,並加入了空格容錯,允許數字中帶有空格
    Dim Numeric As Currency, IntPart As Long, DecimalPart As Byte, MyField As Field, Label As String
    Dim Jiao As Byte, Fen As Byte, Oddment As String, Odd As String, MyChinese As String
    Dim strNumber As String
    Const ZWDX As String = "壹貳叄肆伍陸柒捌玖零"    '定義一箇中文大寫漢字常量
    On Error Resume Next    '錯誤忽略
    With Selection
        strNumber = VBA.Replace(.Text, " ", "")
        Numeric = VBA.Round(VBA.CCur(strNumber), 2)    '四捨五入保留小數點後兩位
        '判斷是否在表格中
        If .Information(wdWithInTable) Then _
           .MoveRight unit:=wdCell Else .MoveRight unit:=wdCharacter
        '對資料進行判斷,是否在指定的範圍內
        If VBA.Abs(Numeric) > 2147483647 Then MsgBox "數值超過範圍!", _
           vbOKOnly + vbExclamation, "Warning": Exit Sub
        IntPart = Int(VBA.Abs(Numeric))    '定義一個正整數
        Odd = VBA.IIf(IntPart = 0, "", "圓")    '定義一個STRING變數
        '插入中文大寫前的標籤
        Label = VBA.IIf(Numeric = VBA.Abs(Numeric), "", "　負")
        '對小數點後面二位數進行擇定
        DecimalPart = (VBA.Abs(Numeric) - IntPart) * 100
        Select Case DecimalPart
        Case Is = 0    '如果是0,即是選定的資料為整數
            Oddment = VBA.IIf(Odd = "", "", Odd & "整")
        Case Is < 10    '<10,即是零頭是分
            Oddment = VBA.IIf(Odd <> "", "圓零" & VBA.Mid(ZWDX, DecimalPart, 1) & "分", _
                              VBA.Mid(ZWDX, DecimalPart, 1) & "分")
        Case 10, 20, 30, 40, 50, 60, 70, 80, 90    '如果是角整
            Oddment = "圓" & VBA.Mid(ZWDX, DecimalPart / 10, 1) & "角整"
        Case Else    '既有角,又有分的情況
            Jiao = VBA.Left(CStr(DecimalPart), 1)    '取得角面值
            Fen = VBA.Right(CStr(DecimalPart), 1)    '取得分面值
            Oddment = Odd & VBA.Mid(ZWDX, Jiao, 1) & "角"    '轉換為角的中文大寫
            Oddment = Oddment & VBA.Mid(ZWDX, Fen, 1) & "分"    '轉換為分的中文大寫
        End Select
        '指定區域插入中文大寫格式的域
        Set MyField = .Fields.Add(Range:=.Range, Text:="= " & IntPart & " /*CHINESENUM2")
        MyField.Select    '選定域(最後是用指定文字覆蓋選定區域)
        '如果僅有角分情況下,Mychinese為""
        MyChinese = VBA.IIf(MyField.Result <> "零", MyField.Result, "")
        .Text = Label & MyChinese & Oddment
    End With
End Sub