VBA制作进度条.docx
《VBA制作进度条.docx》由会员分享，可在线阅读，更多相关《VBA制作进度条.docx（34页珍藏版）》请在冰豆网上搜索。
VBA制作进度条
无标题栏窗体进度条
目标：
制作一个无标题栏窗体形式的进度条。
要求：
当进度条到达显示的数值后，数值设置为白色，否则数值设置为蓝色。
步骤：
1.创建用户窗体
创建一个excel工作簿，进入VBA编辑环境，在当前工程中添加一个用户窗体UserForm1。
设置窗体的Height、Width属性分别为38和241，ShowModal属性为False。
2.添加文字框TextBox1
在窗体上添加一个文字框TextBox1，作为进度条的白色背景。
设置其Height、Width、Left、Top属性分别为18、220、8和8，TabStop属性为False，Text属性为空白。
背景颜色BackColor属性用默认的“白色”，BackSyle属性用默认的1（不透明），SpecialEffect属性用默认的2（凹下）。
3.添加文字框TextBox2
在窗体上添加一个文字框TextBox2，用来显示进度条的百分比。
设置其Height、Width、Left、Top属性分别为18、40、98和12，TabStop属性为False，TextAlign属性为2（水平居中），文字颜色为蓝色，BackSyle设置为0（透明），SpecialEffect属性设置为0（平面）。
4.添加标签Label1
在窗体中添加一个标签Label1，作为进度条。
设置其Height、Width、Left、Top属性分别为18、0、8和8，Caption属性为空白，BackColor属性为“蓝色”。
5.声明API函数和常量
在窗体的快捷菜单中选择“查看代码”，用下列语句声明API函数和常量：
PrivateDeclareFunctionDrawMenuBarLib"user32"（ByValhwndAsLong）AsLong
PrivateDeclareFunctionGetWindowLongLib"user32"Alias"GetWindowLongA"_
（ByValhwndAsLong,ByValnIndexAsLong）AsLong
PrivateDeclareFunctionSetWindowLongLib"user32"Alias"SetWindowLongA"_
（ByValhwndAsLong,ByValnIndexAsLong,ByValdwNewLongAsLong）AsLong
PrivateDeclareFunctionFindWindowLib"user32"Alias"FindWindowA"_
（ByVallpClassNameAsString,ByVallpWindowNameAsString）AsLong
PrivateConstGWL_STYLEAsLong=（-16）
PrivateConstWS_CAPTIONAsLong=&HC00000
6.编写窗体的初始化代码
在用户窗体的初始化事件中编写如下代码，隐藏该窗体的标题栏：
PrivateSubUserForm_Initialize（）
IfVal（Application.Version）<9Then
hwnd=FindWindow（"ThunderXFrame",Me.Caption）
Else
hwnd=FindWindow（"ThunderDFrame",Me.Caption）
EndIf
IStyle=GetWindowLong（hwnd,GWL_STYLE）
IStyle=IStyleAndNotWS_CAPTION
SetWindowLonghwnd,GWL_STYLE,IStyle
DrawMenuBarhwnd
EndSub
7.编写子程序jd
为了在窗体中显示进度条和完成的百分比，我们在模块中建立一个子程序jd，代码如下：
Subjd（h,lr）
'h表示当前次数，lr表示总次数
UserForm1.Label1.Width=Int（h/lr*220）'显示进度条
IfUserForm1.Label1.Width>105Then'进度到达显示数值
UserForm1.TextBox2.ForeColor=&HFFFFFF'数值设置为白色
Else
UserForm1.TextBox2.ForeColor=&HFF0000'数值设置为蓝色
EndIf
pct=Int（h/lr*100）'进度值
pct=IIf（pct<10,""&pct&"%",pct&"%"）'显示进度值
UserForm1.TextBox2.Text=pct
EndSub
8.测试进度条
为了测试这个无标题栏窗体进度条，我们在模块中再建立一个子程序“进度条”，代码如下：
Sub进度条（）
UserForm1.Show'显示用户窗体
cnt=10000'循环次数控制
Form=1Tocnt
Calljd（m,cnt）
DoEvents'转让控制权给操作系统
Next
UnloadUserForm1'卸载用户窗体
EndSub
执行“进度条”子程序后，屏幕上将显示如下图的信息：
以下是一些常用的API函数：
1.API之网络函数
WNetAddConnection创建同一个网络资源的永久性连接
WNetAddConnection2创建同一个网络资源的连接
WNetAddConnection3创建同一个网络资源的连接
WNetCancelConnection结束一个网络连接
WNetCancelConnection2结束一个网络连接
WNetCloseEnum结束一次枚举操作
WNetConnectionDialog启动一个标准对话框，以便建立同网络资源的连接
WNetDisconnectDialog启动一个标准对话框，以便断开同网络资源的连接
WNetEnumResource枚举网络资源
WNetGetConnection获取本地或已连接的一个资源的网络名称
WNetGetLastError获取网络错误的扩展错误信息
WNetGetUniversalName获取网络中一个文件的远程名称以及/或者UNC（统一命名规范）名称
WNetGetUser获取一个网络资源用以连接的名字
WNetOpenEnum启动对网络资源进行枚举的过程
2.API之消息函数
BroadcastSystemMessage将一条系统消息广播给系统中所有的顶级窗口
GetMessagePos取得消息队列中上一条消息处理完毕时的鼠标指针屏幕位置
GetMessageTime取得消息队列中上一条消息处理完毕时的时间
PostMessage将一条消息投递到指定窗口的消息队列
PostThreadMessage将一条消息投递给应用程序
RegisterWindowMessage获取分配给一个字串标识符的消息编号
ReplyMessage答复一个消息
SendMessage调用一个窗口的窗口函数，将一条消息发给那个窗口
SendMessageCallback将一条消息发给窗口
SendMessageTimeout向窗口发送一条消息
SendNotifyMessage向窗口发送一条消息
3.API之文件处理函数
CloseHandle关闭一个内核对象。
其中包括文件、文件映射、进程、线程、安全和同步对象等
CompareFileTime对比两个文件的时间
CopyFile复制文件
CreateDirectory创建一个新目录
CreateFile打开和创建文件、管道、邮槽、通信服务、设备以及控制台
CreateFileMapping创建一个新的文件映射对象
DeleteFile删除指定文件
DeviceIoControl对设备执行指定的操作
DosDateTimeToFileTime将DOS日期和时间值转换成一个win32FILETIME值
FileTimeToDosDateTime将一个win32FILETIME值转换成DOS日期和时间值
FileTimeToLocalFileTime将一个FILETIME结构转换成本地时间
FileTimeToSystemTime根据一个FILETIME结构的内容，装载一个SYSTEMTIME结构
FindClose关闭由FindFirstFile函数创建的一个搜索句柄
FindFirstFile根据文件名查找文件
FindNextFile根据调用FindFirstFile函数时指定的一个文件名查找下一个文件
FlushFileBuffers针对指定的文件句柄，刷新内部文件缓冲区
FlushViewOfFile将写入文件映射缓冲区的所有数据都刷新到磁盘
GetBinaryType判断文件是否可以执行
GetCompressedFileSize判断一个压缩文件在磁盘上实际占据的字节数
GetCurrentDirectory在一个缓冲区中装载当前目录
GetDiskFreeSpace获取与一个磁盘的组织有关的信息，以及了解剩余空间的容量
GetDiskFreeSpaceEx获取与一个磁盘的组织以及剩余空间容量有关的信息
GetDriveType判断一个磁盘驱动器的类型
GetExpandedName取得一个压缩文件的全名
GetFileAttributes判断指定文件的属性
GetFileInformationByHandle这个函数提供了获取文件信息的一种机制
GetFileSize判断文件长度
GetFileTime取得指定文件的时间信息
GetFileType在给出文件句柄的前提下，判断文件类型
GetFileVersionInfo从支持版本标记的一个模块里获取文件版本信息
GetFileVersionInfoSize针对包含了版本资源的一个文件，判断容纳文件版本信息需要一个多大的缓冲区
GetFullPathName获取指定文件的完整路径名
GetLogicalDrives判断系统中存在哪些逻辑驱动器字母
GetLogicalDriveStrings获取一个字串，其中包含了当前所有逻辑驱动器的根驱动器路径
GetOverlappedResult判断一个重叠操作当前的状态
GetPrivateProfileInt为初始化文件（.ini文件）中指定的条目获取一个整数值
GetPrivateProfileSection获取指定小节（在.ini文件中）所有项名和值的一个列表
GetPrivateProfileString为初始化文件中指定的条目取得字串
GetProfileInt取得win.ini初始化文件中指定条目的一个整数值
GetProfileSection获取指定小节（在win.ini文件中）所有项名和值的一个列表
GetProfileString为win.ini初始化文件中指定的条目取得字串
GetShortPathName获取指定文件的短路径名
GetSystemDirectory取得Windows系统目录（即System目录）的完整路径名
GetTempFileName这个函数包含了一个临时文件的名字，它可由应用程序使用
GetTempPath获取为临时文件指定的路径
GetVolumeInformation获取与一个磁盘卷有关的信息
GetWindowsDirectory获取Windows目录的完整路径名
hread参考lread
hwrite参考lwrite函数
lclose关闭指定的文件
lcreat创建一个文件
llseek设置文件中进行读写的当前位置
LockFile锁定文件的某一部分，使其不与其他应用程序共享
LockFileEx与LockFile相似，只是它提供了更多的功能
lopen以二进制模式打开指定的文件
lread将文件中的数据读入内存缓冲区
lwrite将数据从内存缓冲区写入一个文件
LZClose关闭由LZOpenFile或LZInit函数打开的一个文件
LZCopy复制一个文件
LZInit这个函数用于初始化内部缓冲区
LZOpenFile该函数能执行大量不同的文件处理，而且兼容于压缩文件
LZRead将数据从文件读入内存缓冲区
LZSeek设置一个文件中进行读写的当前位置
MapViewOfFile将一个文件映射对象映射到当前应用程序的地址空间
MoveFile移动文件
OpenFile这个函数能执行大量不同的文件操作
OpenFileMapping打开一个现成的文件映射对象
QueryDosDevice在WindowsNT中，DOS设备名会映射成NT系统设备名。
该函数可判断当前的设备映射情况
ReadFile从文件中读出数据
ReadFileEx与ReadFile相似，只是它只能用于异步读操作，并包含了一个完整的回调
RegCloseKey关闭系统注册表中的一个项（或键）
RegConnectRegistry访问远程系统的部分注册表
RegCreateKey在指定的项下创建或打开一个项
RegCreateKeyEx在指定项下创建新项的更复杂的方式。
在Win32环境中建议使用这个函数
RegDeleteKey删除现有项下方一个指定的子项
RegDeleteValue删除指定项下方的一个值
RegEnumKey枚举指定项的子项。
在Win32环境中应使用RegEnumKeyEx
RegEnumKeyEx枚举指定项下方的子项
RegEnumValue枚举指定项的值
RegFlushKey将对项和它的子项作出的改动实际写入磁盘
RegGetKeySecurity获取与一个注册表项有关的安全信息
RegLoadKey从以前用RegSaveKey函数创建的一个文件里装载注册表信息
RegNotifyChangeKeyValue注册表项或它的任何一个子项发生变化时，用这个函数提供一种通知机制
RegOpenKey打开一个现有的注册表项
RegOpenKeyEx打开一个现有的项。
在win32下推荐使用这个函数
RegQueryInfoKey获取与一个项有关的信息
RegQueryValue取得指定项或子项的默认（未命名）值
RegQueryValueEx获取一个项的设置值
RegReplaceKey用一个磁盘文件保存的信息替换注册表信息；并创建一个备份，在其中包含当前注册表信息
RegRestoreKey从一个磁盘文件恢复注册表信息
RegSaveKey将一个项以及它的所有子项都保存到一个磁盘文件
RegSetKeySecurity设置指定项的安全特性
RegSetValue设置指定项或子项的默认值
RegSetValueEx设置指定项的值
RegUnLoadKey卸载指定的项以及它的所有子项
RemoveDirectory删除指定目录
SearchPath查找指定文件
SetCurrentDirectory设置当前目录
SetEndOfFile针对一个打开的文件，将当前文件位置设为文件末尾
SetFileAttributes设置文件属性
SetFilePointer在一个文件中设置当前的读写位置
SetFileTime设置文件的创建、访问及上次修改时间
SetHandleCount这个函数不必在win32下使用；即使使用，也不会有任何效果
SetVolumeLabel设置一个磁盘的卷标（Label）
SystemTimeToFileTime根据一个FILETIME结构的内容，载入一个SYSTEMTIME结构
UnlockFile解除对一个文件的锁定
UnlockFileEx解除对一个文件的锁定
UnmapViewOfFile在当前应用程序的内存地址空间解除对一个文件映射对象的映射
VerFindFile用这个函数决定一个文件应安装到哪里
VerInstallFile用这个函数安装一个文件
VerLanguageName这个函数能根据16位语言代码获取一种语言的名称
VerQueryValue这个函数用于从版本资源中获取信息
WriteFile将数据写入一个文件
WriteFileEx与WriteFile类似，只是它只能用于异步写操作，并包括了一个完整的回调
WritePrivateProfileSection为一个初始化文件（.ini）中指定的小节设置所有项名和值
WritePrivateProfileString在初始化文件指定小节内设置一个字串
WriteProfileSection为Win.ini初始化文件中一个指定的小节设置所有项名和值
WriteProfileString在Win.ini初始化文件指定小节内设置一个字串
4.API之文本和字体函数
AddFontResource在Windows系统中添加一种字体资源
CreateFont用指定的属性创建一种逻辑字体
CreateFontIndirect用指定的属性创建一种逻辑字体
CreateScalableFontResource为一种TureType字体创建一个资源文件，以便能用API函数
AddFontResource将其加入Windows系统
DrawText将文本描绘到指定的矩形中
DrawTextEx与DrawText相似，只是加入了更多的功能
EnumFontFamilies列举指定设备可用的字体
EnumFontFamiliesEx列举指定设备可用的字体
EnumFonts列举指定设备可用的字体
ExtTextOut经过扩展的文本描绘函数。
也请参考SetTextAlign函数
GetAspectRatioFilterEx用SetMapperFlags要求Windows只选择与设备当前纵横比相符的光栅字体时，本函数可判断纵横比大小
GetCharABCWidths判断TureType字体中一个或多个字符的A-B-C大小
GetCharABCWidthsFloat查询一种字体中一个或多个字符的A-B-C尺寸
GetCharacterPlacement该函数用于了解如何用一个给定的字符显示一个字串
GetCharWidth调查字体中一个或多个字符的宽度
GetFontData接收一种可缩放字体文件的数据
GetFontLanguageInfo返回目前选入指定设备场景中的字体的信息
GetGlyphOutline取得TureType字体中构成一个字符的曲线信息
GetKerningPairs取得指定字体的字距信息
GetOutlineTextMetrics接收与TureType字体内部特征有关的详细信息
GetRasterizerCaps了解系统是否有能力支持可缩放的字体
GetTabbedTextExtent判断一个字串占据的范围，同时考虑制表站扩充的因素
GetTextAlign接收一个设备场景当前的文本对齐标志
GetTextCharacterExtra判断额外字符间距的当前值
GetTextCharset接收当前选入指定设备场景的字体的字符集标识符
GetTextCharsetInfo获取与当前选定字体的字符集有关的详细信息
GetTextColor判断当前字体颜色。
通常也称为“前景色”
GetTextExtentExPoint判断要填入指定区域的字符数量。
也用一个数组装载每个字符的范围信息
GetTextExtentPoint判断一个字串的大小（范围）
GetTextFace获取一种字体的字样名
GetTextMetrics获取与选入一种设备场景的物理字体有关的信息
GrayString描绘一个以灰色显示的字串。
通常由Windows用于标识禁止状态
PolyTextOut描绘一系列字串
RemoveFontResource从Windows系统中删除一种字体资源
SetMapperFlagsWindows对字体进行映射时，可用该函数选择与目标设备的纵横比相符的光栅字体
SetTextAlign设置文本对齐方式，并指定在文本输出过程中使用设备场景的当前位置
SetTextCharacterExtra描绘文本的时候，指定要在字符间插入的额外间距
SetTextColor设置当前文本颜色。
这种颜色也称为“前景色”
SetTextJustification通过指定一个文本行应占据的额外空间，可用这个函数对文本进行两端对齐处理
TabbedTextOut支持制表站的一个文本描绘函数
TextOut文本绘图函数
5.API之绘图函数
AbortPath抛弃选入指定设备场景中的所有路径。
也取消目前正在进行的任何路径的创建工作
AngleArc用一个连接弧画一条线
Arc画一个圆弧
BeginPath启动一个路径分支
CancelDC取消另一个线程里的长时间绘图操作
Chord画一个弦
CloseEnhMetaFile关闭指定的增强型图元文件设备场景，并将新建的图元文件返回一个句柄
CloseFigure描绘到一个路径时，关闭当前打开的图形
CloseMetaFile关闭指定的图元文件设备场景，并向新建的图元文件返回一个句柄
CopyEnhMetaFile制作指定增强型图元文件的一个副本（拷贝）
CopyMetaFile制作指定（标准）图元文件的一个副本
CreateBrushIndirect在一个LOGBRUSH数据结构的基础上创建一个刷子
CreateDIBPatternBrush用一幅与设备无关的位图创建一个刷子，以便指定刷子样式（图案）
CreateEnhMetaFile创建一个增强型的图元文件设备场景
CreateHatchBrush创建带有阴影图案的一个刷子
CreateMetaFile创建一个图元文件设备场景
CreatePatternBrush用指定了刷子图案的一幅位图创建一个刷子
CreatePen用指定的样式、宽度和颜色创建一个画笔
CreatePenIndirect根据指定的LOGPEN结构创建一个画笔
CreateSolidBrush用纯色创建一个刷子
DeleteEnhMetaFile删除指定的增强型图元文件
DeleteMetaFile删除指定的图元文件
DeleteObject删除GDI对象，对象使用的所有系统资源都会被释放
DrawEdge用指
升级会员 