小写金额变大写-局限于20亿

Sub 小写金额变大写()
'
' 小写金额变大写 Macro
' 宏在 2014-7-24 由 MC SYSTEM 创建
'

Dim Numeric As Currency, IntPart As Long, DecimalPart As Byte, MyField As Field, Lable As String
Dim Jiao As Byte, Fen As Byte, Oddment As String, Odd As String, MyChinese As String

Const ZWDX As String = "壹贰叁肆伍陆柒捌玖零"   '定义一个中文大写汉字常量

With Selection
 
  Numeric = VBA.Round(VBA.Val(.Text), 2)   '四舍五入保留小数点后两位
  
  '判断是否在表格中
  If .Information(wdWithInTable) Then
      .MoveRight unit:=wdCell   '如在表格中，则光标自动跳到下一个位置
  Else
    .MoveRight unit:=wdCharacter '如果不在表格中，则光标自动跳到选中文本前面
  End If
  
   '对数据进行判断,是否在指定的范围内
    If VBA.Abs(Numeric) > 2147483647 Then
       MsgBox "数值超过范围!", vbOKOnly + vbExclamation, "Warning": Exit Sub
    End If
    IntPart = Int(VBA.Abs(Numeric))        '定义一个正整数
    Odd = VBA.IIf(IntPart = 0, "", "元")   '定义一个STRING变量
    
    '插入中文大写前的标签
    Lable = 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.IIf(Odd <> "", "元" & VAB.Mid(ZWDX, DecimalPart / 10, 1) & "角", VAB.Mid(ZWDX, DecimalPart / 10, 1) & "角")
        Case Else '既有角又有分
           Jiao = VBA.Left(CStr(DecimalPart), 1)   '取得角面值
           Fen = VBA.Right(CStr(DecimalPart), 1)   '取得分面值
          Oddment = VBA.IIf(Odd <> "", "元" & VBA.Mid(ZWDX, Jiao, 1) & "角" & VBA.Mid(ZWDX, Fen, 1) & "分", Mid(ZWDX, Jiao, 1) & "角" & 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 = Lable & MyChinese & Oddment
    
End With
           
End Sub