求高人用VB6.0中的外接程序帮我封装代码，谢谢！！！！

xrs08234

以下代码是右键菜单实现小写金额转为大写金额，求高人帮我封装成Excel的右键菜单，谢谢！！！！！
Private Sub Workbook_Open()
    Application.CommandBars("Cell").Reset
   '添加一级菜单
    Set 一级菜单 = Application.CommandBars("Cell").Controls.Add(Type:=msoControlPopup, Before:=1) '取消参数before，新建菜单排列在原菜单的末尾
    一级菜单.Caption = "金额大写"
     '添加二级菜单
    Set 二级菜单 = 一级菜单.Controls.Add(Type:=msoControlButton)
    With 二级菜单
        .Caption = "小写转换大写"
        .Style = msoButtonCaption
        .OnAction = "大写金额工具"
    End With
End Sub


Sub 大写金额工具()
    If ActiveCell = "" Then Exit Sub
    If IsNumeric(ActiveCell) Then
    ActiveCell = dx(ActiveCell)
    End If
End Sub


Function dx(q)
ybb = Round(q * 100) '将输入的数值扩大100倍，进行四舍五入
y = Int(ybb / 100) '截取出整数部分
j = Int(ybb / 10) - y * 10 '截取出十分位
f = ybb - y * 100 - j * 10 '截取出百分位
zy = Application.WorksheetFunction.Text(y, "[DBNum2]") '将整数部分转为中文大写
zj = Application.WorksheetFunction.Text(j, "[DBNum2]") '将十分位转为中文大写
zf = Application.WorksheetFunction.Text(f, "[DBNum2]") '将百分位转为中文大写
dx = "大写(人民币):" & zy & "圆" & "整"
d1 = "大写(人民币):" & zy & "圆"
If f <> 0 And j <> 0 Then
  dx = d1 & zj & "角" & zf & "分"
  If y = 0 Then
           dx = "大写(人民币):" & zj & "角" & zf & "分"
     End If
End If
If f = 0 And j <> 0 Then
   dx = d1 & zj & "角" & "整"
   If y = 0 Then
      dx = "大写(人民币):" & zj & "角" & "整"
   End If
End If
If f <> 0 And j = 0 Then
  dx = d1 & zj & zf & "分"
  If y = 0 Then
     dx = "大写(人民币):" & zf & "分"
  End If
End If

If q = 0 Or q = "" Then
   dx = "大写(人民币):零圆整" '如没有输入任何数值为0
End If
End Function

xrs08234

高人不在？？？？？

excel333

已经完成，看附件：

xrs08234

朋友，谢谢你的帮助。我测试了一下，右键没有出现这个功能，能把源码给我看看嘛，学习哈。

excel333

xrs08234 发表于 2012-5-14 08:33
朋友，谢谢你的帮助。我测试了一下，右键没有出现这个功能，能把源码给我看看嘛，学习哈。

可以啊！应解压后使用：

xrs08234

嗯，可以了，谢谢你的无私帮助。能否把VB6.0的源码发给我学习学习，邮箱xrs08234@126.com，谢谢！！！

jicqj

封装源码来了  好好学习

qczvba

jicqj 发表于 2012-5-20 02:41
封装源码来了  好好学习

谢谢大力兄，谢谢，很好的代码。没人顶，太可惜了。

xrs08234

谢谢热心的朋友，俺研究研究！！！！11

yeshuangyong

非常好，正需要，谢谢