word文档能不能自动输入数字的大写
可以的。万能的vba无所不能。以前做过的一个任务,截取部分代码供参考!PublicFunctionNum2Money(ByValnMoneyAsCurrency)AsString'2010.05.04修改DimstrMoney,strDec,strInt,cNumAsStringDimlocDec,i,jAsLong'小数点位置Dimd(4)AsString'元以下的单位Dimt(3)AsString'万以下的单位Dimw(3)AsString'阶符Dimn(9)AsString'数字Dims(4)AsString'用以保存临时转化后的值OnErrorResumeNextd(0)="":d(1)="角":d(2)="分":d(3)="厘":d(4)="毫"t(0)="":t(1)="拾":t(2)="佰":t(3)="仟"w(0)="":w(1)="元":w(2)="万":w(3)="亿"n(0)="零":n(1)="壹":n(2)="贰":n(3)="叁":n(4)="肆":n(5)="伍":n(6)="陆":n(7)="柒":n(8)="捌":n(9)="玖"IfnMoney=0Then'为"0"则退出Num2Money=vbNullStringExitFunctionEndIfIfnMoney0ThenstrDec=VBA.Right(strMoney,Len(strMoney)-locDec)IfstrDec"0"Thens(0)=s(0)&n(Val(cNum))&d(i)EndIfNextEndIfstrInt=VBA.Left(strMoney,locDec-1)'取整数部分的值ElsestrInt=strMoneyEndIf'考虑到VB中货币型变量的范围,不超过"1000万亿".&_(-922,337,203,685,477.5808~922,337,203,685,477.5807)Fori=0ToLen(strInt)/4'每4个数字一组进行转换s(i+1)=""Forj=0To3IfstrInt"0"Then'不为零则加单位s(i+1)=n(Val(cNum))&t(j)&s(i+1)Elses(i+1)=n(Val(cNum))&s(i+1)EndIfEndIf'删除重复的"零"s(i+1)=Replace(s(i+1),"零零","零")NextIfVBA.Right(s(i+1),1)="零"Then'删除末位的"零"s(i+1)=VBA.Left(s(i+1),Len(s(i+1))-1)EndIfNextNum2Money=""Fori=0To2'连接整数位Num2Money=Num2Money&s(3-i)&IIf(VBA.Trim(s(3-i))=vbNullString,vbNullString,w(3-i))NextDimNumTrim2MoneyAsString'加上"元"IfVBA.Trim(Num2Money)"元"ThenNumTrim2Money=Num2Money&"元"EndIf'若无小数则加应加上"整"IfVBA.Trim(s(0))=vbNullStringThenNum2Money=Num2Money&"整"ElseNum2Money=Num2Money&s(0)EndIfIfVBA.Right(Num2Money,1)"整"ThenNum2Money=Num2Money&"整"EndIfIfVBA.Right(VBA.Trim(Num2Money),1)="分"AndVBA.Left(VBA.Right(VBA.Trim(Num2Money),3),1)="元"ThenNum2Money=VBA.Left(VBA.Trim(Num2Money),Len(VBA.Trim(Num2Money))-2)&"零"&VBA.Right(VBA.Trim(Num2Money),2)EndIfEndFunctionPrivateSub替换文本_市场(bh,lx,qy,dy,lc,mj,qzrq,dqrq,zq,xflb,zj,yj,xm,dh,sfzhm)Dim当前路径,导出文件名,导出路径文件名AsStringDimStr1,Str2Dimtarr(1To27,1To2)当前路径=ThisWorkbook.Path导出文件名=bh&".doc"导出文件名2=bh&".xlsx"FileCopy当前路径&"模板房屋租赁合同.doc",当前路径&"待打印WORD文档"&导出文件名FileCopy当前路径&"模板承租申请.xlsx",当前路径&"待打印WORD文档"&导出文件名2WithSheets("关键字")Fori=1To27tarr(i,1)=.Cells(i+1,1)NextiEndWithtarr(1,2)=xmtarr(2,2)=qytarr(3,2)=dytarr(4,2)=lctarr(5,2)=dhtarr(6,2)=sfzhmtarr(7,2)=mjtarr(8,2)=yjtarr(9,2)=Num2Money(yj*12)'大写总租金tarr(10,2)=yj*12'小写总租金SelectCasexflbCase"年"tarr(11,2)=1tarr(12,2)=12tarr(13,2)=Num2Money(zj)tarr(15,2)=""'续费日期2tarr(16,2)=""'续费日期3tarr(17,2)=""'续费日期4tarr(18,2)=12'第一次几个月租金tarr(19,2)="/"tarr(20,2)="/"tarr(21,2)="/"tarr(22,2)=Num2Money(zj)'大写第一次租金tarr(23,2)="/"'大写第二次租金tarr(24,2)="/"'大写第三次租金tarr(25,2)="/"'大写第四次租金Case"半年"tarr(11,2)=2tarr(12,2)=6tarr(13,2)=Num2Money(zj)tarr(15,2)=Int(qzrq+183)tarr(16,2)=""'续费日期3tarr(17,2)=""'续费日期4tarr(18,2)=6'第一次几个月租金tarr(19,2)=6tarr(20,2)="/"tarr(21,2)="/"tarr(22,2)=Num2Money(zj)'大写第一次租金tarr(23,2)=Num2Money(zj)'大写第二次租金tarr(24,2)="/"'大写第三次租金tarr(25,2)="/"'大写第四次租金Case"季度"tarr(11,2)=4tarr(12,2)=3tarr(13,2)=Num2Money(zj)tarr(15,2)=qzrq+90tarr(16,2)=qzrq+183'续费日期3tarr(17,2)=Int(qzrq+(365/4*3+0.5))'续费日期4tarr(18,2)=3'第一次几个月租金tarr(19,2)=3tarr(20,2)=3tarr(21,2)=3tarr(22,2)=Num2Money(zj)'大写第一次租金tarr(23,2)=Num2Money(zj)'大写第二次租金tarr(24,2)=Num2Money(zj)'大写第三次租金tarr(25,2)=Num2Money(zj)'大写第四次租金EndSelecttarr(14,2)=qzrqtarr(27,2)=dqrqIfmj=55Thentarr(26,2)=3ElseIfmj=75Thentarr(26,2)=5Elsetarr(26,2)=6EndIfEndIf导出路径文件名=当前路径&"待打印WORD文档"&导出文件名导出路径文件名2=当前路径&"待打印WORD文档"&导出文件名2Setwdoc=CreateObject("word.application")wdoc.Visible=FalseWithwdoc.Documents.Open导出路径文件名.Visible=TrueFori=1To27'填写文字数据Str1=tarr(i,1)Str2=tarr(i,2)bj=TrueDoWhilebj.Selection.HomeKeyUnit:=wdStory'光标置于文件首If.Selection.Find.Execute(Str1)Then'查找到指定字符串'.Selection.Font.Color=wdColorAutomatic'字符为自动颜色.Selection.Text=Str2'替换字符串Elsebj=FalseEndIfLoopNextiEndWithwdoc.Documents.Savewdoc.QuitSetwdoc=Nothing'写入承租申请'房号!区域!单元!楼层'户型!面积'承租说明付款方式:!周期!续费日期!续费Setmyb=Workbooks.Open(导出路径文件名2)DimxfrqAsDate'续费日期SelectCasexflbCase"年"xfrq=dqrqCase"半年"xfrq=qzrq+182Case"季度"xfrq=qzrq+91EndSelectWithmyb.Sheets("sheet1").Cells(3,2)=xm.Cells(4,2)=dh.Cells(5,2)=sfzhm.Cells(6,2)=qzrq.Cells(7,2)=dqrq.Cells(3,6)=qy&Space(1)&dy&Space(1)&lc.Cells(4,6)=mj.Cells(5,6)=yj*12.Cells(6,6)=yj.Cells(7,6)="".Cells(9,1)=zq&""&xfrq&""&xflbEndWithmyb.Savemyb.CloseEndSub