资源描述:
《实用Excel宏代码库》由会员上传分享,免费在线阅读,更多相关内容在教育资源-天天文库。
1、Function人民币大写转换(M) y=Int(Round(100*Abs(M))/100) 'NT函数将数字向下舍入到最接近的整数,即取不大于自变量的最大整数,例如:int[6.4]=6int[-9.7]=-10.y取的为数字的整数部分。(元) j=Round(100*Abs(M)+0.00001)-y*100 'j取的为小数部分(角) f=(j/10-Int(j/10))*10 'f为分, A=IIf(y<1,"",Application.Text(y,"[DBNum2]")&"元") 'IIf(expr,truep
2、art,falsepart) b=IIf(j>9.5,Application.Text(Int(j/10),"[DBNum2]")&"角",IIf(y<1,"",IIf(f>1,"零",""))) c=IIf(f<1,"整",Application.Text(Round(f,0),"[DBNum2]")&"分") 人民币大写转换=IIf(Abs(M)<0.005,"",IIf(M<0,"负"&A&b&c,A&b&c))EndFunction--------------------------------------------
3、-----------------------------------------为工作表瘦身(一)SubCountShapes() DimnAsDouble DimwsAsWorksheet DimContentAsString ForEachwsInWorksheets n=ws.Shapes.Count Content=Content&"工作表"&ws.Name&"有"&n&"个对象"&vbCrLf Next MsgBoxContentEndSub(二)SubDelAllShapes(
4、) DimwsAsWorksheet DimspAsShape DimnAsDouble DimContentAsString ForEachwsInWorksheets ForEachspInws.Shapes Ifsp.Width<14.25Andsp.Height<14.25Then sp.Delete n=n+1 EndIf Next Content=Content&"工作表"&w
5、s.Name&"删除了"&n&"个对象"&vbCrLf n=0 Next MsgBoxContentEndSub(三)SubDelShapes() DimspAsShape,n ForEachspInActiveSheet.Shapes Ifsp.Width<14.25Andsp.Height<14.25Then sp.Delete n=n+1 EndIf Nextsp MsgBox"共删除了"&n&"个对象"EndSub---------
6、------------------------------------------------------------------------------获取超链接名称FunctionGetName(HyCell) Application.VolatileTrue GetName=HyCell.Hyperlinks(1).NameEndFunction获取超链接地址FunctionGetAddress(HyCell) Application.VolatileTrue WithHyCell.Hyperlinks(1)
7、 GetAddress=IIf(.Address="",.SubAddress,.Address) EndWithEndFunction--------------------------------------------------------------------------------------个性化启动画面PrivateSubUserForm_Initialize() '设置窗体标题 Me.Caption="ExcelHome零售分析系统" '10秒钟后调用HideForm Application.
8、OnTimeNow+TimeValue("00:00:10"),"HideForm"EndSubPrivateSubUserForm_QueryClose(CancelAsInteger,Cl