自定义进度条
API的用处不是一时半会就可以说完了，但例子还是要一个个给，现在给出第二个利用API的例子，在Excel的状态栏中显示自定义的进度条。
"//此模块创建了一个显示在状态栏的自定义进度条，并可对状态栏的文字进行设置
"//——以下声明API函数——
"//创建文字函数，其中fCharacterSet：字符集;134为GB2312
PrivateDeclareFunctionCreateFontLib"gdi32"Alias"CreateFontA"(ByValfHeightAsLong,ByValfWidthAsLong,ByValfEscapementAsLong,ByValfOrientationAsLong,ByValfWeightAsLong,ByValfItalicAsLong,ByValfUnderlineAsLong,ByValfStrikeoutAsLong,ByValfCharacterSetAsLong,ByValfPrecisionAsLong,ByValfClippingAsLong,ByValfQualityAsLong,ByValfPitchAndFamilyAsLong,ByValfNameAsString)AsLong
"//取得窗体设备环境函数
PrivateDeclareFunctionGetDCLib"user32"(ByValhwndAsLong)AsLong
"//设置环境内容，此处为文字
PrivateDeclareFunctionSelectObjectLib"gdi32"(ByValhdcAsLong,ByValhObjectAsLong)AsLong
"//删除创建的环境内容
PrivateDeclareFunctionDeleteObjectLib"gdi32"(ByValhObjectAsLong)AsLong
"//释放设备环境
PrivateDeclareFunctionReleaseDCLib"user32"(ByValhwndAsLong,ByValhdcAsLong)AsLong
"//该函数创建一个具有扩展风格的重叠式窗口、弹出式窗口或子窗口
PrivateDeclareFunctionCreateWindowEXLib"user32"Alias"CreateWindowExA"(ByValdwExStyleAsLong,ByVallpClassNameAsString,ByVallpWindowNameAsString,ByValdwStyleAsLong,ByValxAsLong,ByValyAsLong,ByValnWidthAsLong,ByValnHeightAsLong,ByValhWndParentAsLong,ByValhMenuAsLong,ByValhInstanceAsLong,lpParamAsAny)AsLong
"//破坏创建的窗口
PrivateDeclareFunctionDestroyWindowLib"user32"(ByValhwndAsLong)AsLong
"//设置一个窗口为另一窗口的子窗口
PrivateDeclareFunctionSetParentLib"user32"(ByValhWndChildAsLong,ByValhWndNewParentAsLong)AsLong
"//视情况向窗体发送不同的信息
PrivateDeclareFunctionSendMessageLib"user32"Alias"SendMessageA"(ByValhwndAsLong,ByValwMsgAsLong,ByValwParamAsLong,lParamAsAny)AsLong
"//查找窗口句柄
PrivateDeclareFunctionFindWindowLib"user32"Alias"FindWindowA"(ByVallpClassNameAsString,ByVallpWindowNameAsString)AsLong
"//查找一个窗口中子窗口的句柄
PrivateDeclareFunctionFindWindowExLib"user32"Alias"FindWindowExA"(ByValhWnd1AsLong,ByValhWnd2AsLong,ByVallpsz1AsString,ByVallpsz2AsString)AsLong
"//设置场景背景色
PrivateDeclareFunctionSetBkColorLib"gdi32"(ByValhdcAsLong,ByValcrColorAsLong)AsLong
"//设置文本颜色
PrivateDeclareFunctionSetTextColorLib"gdi32"(ByValhdcAsLong,ByValcrColorAsLong)AsLong
"//取得系统色
PrivateDeclareFunctionGetSysColorLib"user32"(ByValnIndexAsLong)AsLong
"//取得窗体客户区坐标
PrivateDeclareFunctionGetClientRectLib"user32"(ByValhwndAsLong,lpRectAsRECT)AsLong
"//——以下定义常量及类型——
PrivateConstWS_VISIBLE=&H10000000"可见
PrivateConstWS_CHILD=&H40000000"子窗口
PrivateConstWS_BORDER=&H800000"单边框
PrivateConstPBS_STANDARD=&H0"标准
PrivateConstPBS_SMOOTH=&H1"平滑
PrivateConstCCM_FIRST=&H2000&
PrivateConstWM_USER=&H400
PrivateConstPBM_SETBKCOLOR=(CCM_FIRST+1)"设置进度条背景色
PrivateConstPBM_SETPOS=(WM_USER+2)"设置进度条状态
PrivateConstPBM_SETBARCOLOR=(WM_USER+9)"设置进度条颜色
PrivateConstCOLOR_BTNFACE=15"系统按纽背景色
PrivateTypeRECT
LeftAsLong
TopAsLong
RightAsLong
BottomAsLong
EndType
"//进度条显示时的样式
EnumPBType
P_STANDARD=WS_VISIBLEOrWS_CHILDOrWS_BORDEROrPBS_STANDARD"标准样式
P_SMOOTH=WS_VISIBLEOrWS_CHILDOrWS_BORDEROrPBS_SMOOTH"平滑式
EndEnum
"//文字的字体粗细需在0到1000之间，例如，400代表普通，700代表粗体，而0则表示默认。
EnumFnWeight
FW_DONTCARE=0
FW_THIN=100
FW_EXTRALIGHT=200
FW_ULTRALIGHT=200
FW_LIGHT=300
FW_NORMAL=400
FW_REGULAR=400
FW_MEDIUM=500
FW_SEMIBOLD=600
FW_DEMIBOLD=600
FW_BOLD=700
FW_EXTRABOLD=800
FW_ULTRABOLD=800
FW_HEAVY=900
FW_BLACK=900
EndEnum
"//主过程
"//参数如下；
"//FontHeight:文字高度,FontWeight:文字粗细,FontColor:文字颜色,Italic:斜体,lngPBType:进度条类型,MaxVlue:最大值,StopValue:停止值,Prompt:状态栏字符串。
SubStatusBarMsg(FontHeightAsLong,FontWeightAsFnWeight,FontColorAsLong,ItalicAsBoolean,lngPBTypeAsPBType,MaxVlueAsLong,StopValueAsLong,PromptAsString)
DimhwndStatusbarAsLong"状态栏句柄
DimPbHwndAsLong"创建的进度条
DimXlStaBarRectAsRECT"用于装载状态栏区域
DimxlMainAsLong"EXCEL主窗口句柄
DimhDcStatusBarAsLong"状态栏设备环境
DimhFontAsLong,hFontOldAsLong"创建的文字及原文字信息
DimoldStatusBarAsBoolean"原状态栏状态
DimIAsLong,iValAsString
DimStrLenAsInteger"状态栏文本长度
DimGetBarRECTAsLong
StrLen=Len(Prompt)*Abs(FontHeight)+30
"//取得EXCEL主窗口的句柄。
xlMain=FindWindow("XLMAIN",vbNullString)"Excel2002及以后版本可以直接用Application.hWnd来取得Excel主窗口的句柄
"//取得状态栏的句柄。状态栏类名："EXCEL4"
hwndStatusbar=FindWindowEx(xlMain,0,"EXCEL4",vbNullString)
"//取得状态栏的客户区坐标
GetBarRECT=GetClientRect(hwndStatusbar,XlStaBarRect)
"//取得状态栏的场景
hDcStatusBar=GetDC(hwndStatusbar)
"//创建一种将用于状态栏的文字,注意:文字名称的长度必修小于32""新宋体"为自己给定的文字名，可以自行更改
hFont=CreateFont(FontHeight,0,0,0,FontWeight,Italic,0,0,134,0,0,0,0,"新宋体")
"//首先设置新字体并保存原来的字体！
hFontOld=SelectObject(hDcStatusBar,hFont)
"//保存原状态栏状态
oldStatusBar=Application.DisplayStatusBar
Application.DisplayStatusBar=True
"//创建进度条
PbHwnd=CreateWindowEX(0,"msctls_progress32","",lngPBType,StrLen,XlStaBarRect.Top+1,198,_
XlStaBarRect.Bottom-2,hwndStatusbar,0,0,0)
"//将进度条设为状态栏的子窗口
SetParentPbHwnd,hwndStatusbar
"//进度条颜色，颜色可以自行设置
SendMessagePbHwnd,PBM_SETBARCOLOR,0&,ByVal16711680"蓝色
"//进度条背景色，颜色可以自行设置
SendMessagePbHwnd,PBM_SETBKCOLOR,0&,ByVal16777215"白色
"//状态栏背景色，这里用的是按纽背景色
CallSetBkColor(hDcStatusBar,GetSysColor(COLOR_BTNFACE))
"//文字颜色，即状态栏前景色
CallSetTextColor(hDcStatusBar,FontColor)
"//设置状态栏文字
Application.StatusBar=Prompt
ForI=1ToMaxVlue
iVal=I/MaxVlue*100
IfI=StopValueThen
"//保存工作薄
"ActiveWorkbook.Save
CallSetBkColor(hDcStatusBar,GetSysColor(COLOR_BTNFACE))
CallSetTextColor(hDcStatusBar,FontColor)
Application.StatusBar=Prompt
EndIf
"//向进度条发送消息，以更改进度条的状态
SendMessagePbHwnd,PBM_SETPOS,ByValiVal,0&
NextI
"//清除进度条
DestroyWindowPbHwnd
"//恢复原来状态栏的字体
SelectObjecthDcStatusBar,hFontOld
"//释放状态栏的设备场景
ReleaseDChwndStatusbar,hDcStatusBar
"//恢复原状态栏状态
Application.StatusBar=False
Application.DisplayStatusBar=oldStatusBar
EndSub
"//此为工作表中按钮调用程序
SubSaveWorkbook()
CallStatusBarMsg(-12,FW_BOLD,255,False,P_SMOOTH,800000,800000,"正在保存当前工作薄，请稍候……")
EndSub
下面是ThisWorkbook的代码
"//重置自定义设定
PrivateSubWorkbook_BeforeClose(CancelAsBoolean)
WithApplication
.CommandBars("WorksheetMenuBar").Controls("文件(&F)").Controls("保存(&S)").Reset
.CommandBars("Standard").Controls("保存(&S)").Reset
.OnKey"^s"
EndWith
EndSub
"//将菜单,工具栏和快捷键(Ctrl+S)上的保存菜单重设为执行自己的过程
PrivateSubWorkbook_Open()
WithApplication
.CommandBars("WorksheetMenuBar").Controls("文件(&F)").Controls("保存(&S)").OnAction="SaveWorkbook"
.CommandBars("Standard").Controls("保存(&S)").OnAction="SaveWorkbook"
.OnKey"^s","SaveWorkbook"
EndWith
EndSub
这样你就自定义好了进度条，可惜的是这个进度条还不算完善，它不能自行根据保存文件所需要的时间动态变化进度条的演示时间，还有，这时按菜单，工具栏与快捷键Ctrl+S其实都没有保存文件,我把保存文件的这行代码变成备注了！！请注意！点击下载完全代码。
