VB中进度条程序
VB怎么写进度条
VB编写进度条已经发展很久了，也有很多好方法。
VB自带的进度条很难看，一般不用，要用的话，代码如下：Private Sub Command1_Click()Dim counter As IntegerDim workarea(25000) As StringProgressBar1.Min = LBound(workarea)ProgressBar1.Max = UBound(workarea)ProgressBar1.Visible = TrueProgressBar1.Value = ProgressBar1.MinFor counter = LBound(workarea) To UBound(workarea) workarea(counter) = "initial value" & counterProgressBar1.Value = counterNext counterEnd Sub各位看官，直接看下面：Text实现进度条：Option ExplicitDim i As IntegerPrivate Sub Form_Load()Timer1.Enabled = TrueText2.Width = (Form1.Width / 100)End SubPrivate Sub Timer1_Timer()'进度条设置Text2.Width = Text2.Width + (Form1.Width / 100)If (Text2.Width / Form1.Width) > 1 ThenForm2.Show '载入主画面Unload MeEnd IfEnd SubImage进度条：Option ExplicitDim i As IntegerPrivate Sub Form_Load()JDT.Top = Lab.TopJDT.Width = (Lab.Width / 100)End SubPrivate Sub Timer1_Timer()'进度条设置JDT.Width = JDT.Width + (Lab.Width / 100)If (JDT.Width / Lab.Width) > 1 ThenForm1.Show '载入主画面Unload MeEnd IfEnd Sub那么更换N个image就会有N个进度条演示，下面示图，大家自己试试。
一个用VB编写ActiveX自定义控件的例子——进度条控件
一个用VB编写ActiveX自定义控件的例子——进度条控件设计方法：1.在UserControl中添加一个Label控件Label1，将它设为平面，用来做外框。
添加两个PictureBox控件PictureBox1做为进度指示，PictureBox2控件做为控件背景。
2.加入以下代码Option Explicit''定义私有变量用于存储属性值Private mvarMax As LongPrivate mvarMin As LongPrivate mvarValue As LongPrivate Rate As StringPrivate Sub UserControl_Initialize()''初始化Picture2.BackColor = vbBlueEnd SubPublic Property Get BackColor() As OLE_COLOR''读取BackColor属性BackColor = Picture1.BackColorEnd PropertyPublic Property Let BackColor(ByVal vNewValue As OLE_COLOR)''设置BackColor属性Picture1.BackColor = vNewValueEnd PropertyPrivate Sub UserControl_InitProperties()''初始化属性Max = 100Min = 0Value = 0End SubPrivate Sub UserControl_ReadProperties(PropBag As PropertyBag)''读取从属性窗体中设置的属性值mvarMax = PropBag.ReadProperty("Max", 100)mvarMin = PropBag.R eadProperty("Min", 0)''Value属性值这里未提供，主要是模仿VB自带的进度条控件''mvarValue = PropBag.R eadProperty("Value", 0)End SubPrivate Sub UserControl_WriteProperties(PropBag As PropertyBag)''保存从属性窗体中设置的属性值PropBag.WriteProperty "Max", mvarMax, 100PropBag.WriteProperty "Min", mvarMin, 0''PropBag.WriteProperty "Value", mvarValue, 0End SubPrivate Sub UserControl_Resize()''R esize事件Label1.Move 0, 0, UserControl.Width / Screen.TwipsPerPixelX, UserControl.Height / Screen.TwipsPerPixel YPicture1.Move 1, 1, UserControl.Width / Screen.TwipsPerPixelX - 2, UserControl.Height / Screen.TwipsPerPixel Y - 2Picture2.Move 1, 1, 1, UserControl.Height / Screen.TwipsPerPixelY - 2End SubPublic Property Get Max() As Long''读取Max属性Max = mvarMaxEnd PropertyPublic Property Let Max(ByVal vNewValue As Long)''设置Max属性mvarMax = vNewValueIf vNewValue < Min Then Err.Raise "1001", , "Max必须大于Min"End PropertyPublic Property Get Min() As Long''读取Min属性Min = mvarMinEnd PropertyPublic Property Let Min(ByVal vNewValue As Long)''设置Min属性If vNewValue > Max Then Err.Raise "1000", , "Min必须小于Max"mvarMin = vNewValueEnd PropertyPublic Property Get Value() As Long''读取Value属性Value = mvarValueEnd PropertyPublic Property Let Value(ByVal vNewValue As Long)''设置Value属性''原理就是在两个PictureBox中以不同颜色打印百分比进度Dim DX As Long, DY As LongIf vNewValue > Max Then Err.Raise "1002", , "Value不能大于Max"mvarValue = vNewValuePicture2.Width = Value / (Max - Min) * (UserControl.Width / Screen.TwipsPerPixelX - 2) Rate = Int(Value / (Max - Min) * 100) & "%"DX = (Picture1.Width - Picture1.TextWidth(Rate)) / 2DY = (Picture1.Height - Picture1.TextHeight(Rate)) / 2Picture1.ForeColor = vbBlackPicture2.ForeColor = vbWhi t eIf DX < Picture2.Width ThenPicture2.ClsPicture2.CurrentX = DXPicture2.CurrentY = DYPicture2.Print RateElsePicture1.ClsPicture1.CurrentX = DXPicture1.CurrentY = DYPicture1.Print RateEnd IfEnd Property3.新建另一个测试工程，加入一个自己的进度条控件和一个系统的进度条控件，加入以下代码：Option ExplicitPrivate Sub Command1_Click()Unload MeEnd SubPrivate Sub Timer1_Timer()myProgressBar1.Value = myProgressBar1.Value + 2ProgressBar1.Value = ProgressBar1.Value + 2If myProgressBar1.Value = myProgressBar1.Max Then Timer1.Enabled = FalseEnd Sub。
VBA实战技巧30：创建自定义的进度条1
VBA实战技巧30：创建⾃定义的进度条1excelperfect宏是Excel中最好的⼯具之⼀，可以让我们节省时间。
使⽤VBA宏，可以⾃动执⾏重复、单调且有时⾮常⽆聊的任务。
在某些情况下，这有可能将数⼩时的⼯作减少到⼏分钟或⼏秒钟。
但并⾮所有宏都可以实现此类性能要求，有时候数据实在太庞⼤了，电脑只能运⾏这么快。
在极端情况下，任务可能进展得极其缓慢，以致我们认为系统可能已锁定或崩溃。
因此，发明了进度条。
在Windows的早期，机器被认为是缓慢且容易崩溃的。
通过向⽤户提供进度的视觉指⽰器，我们知道系统仍在⼯作，并且可以合理猜测任务何时完成。
在宏执⾏可能需要相当长时间的情况下，为⽤户提供进度条是⼀个不错的选择。
本⽂所介绍的进度条创建过程代码可以⽤于其他任务中，⽰例中，我们的⾃动化过程将遍历表中的记录，在每条记录处暂停1/10秒。
1.设置可视化界⾯使⽤VBA的⽤户窗体创建进度条。
⾸先，在VBE中，单击“插⼊——⽤户窗体”，结果如下图1所⽰。
图1重新命名该窗体名称为“UserForm_v1”，标题为“创建PDF⽂档”，如下图2所⽰。
图2在窗体中：插⼊⼀个标签并设置合适的标题；插⼊⼀幅图像；插⼊⼀个框架，⽤作滚动条的边框并显⽰数字百分⽐计数器。
将其标题设置为“0%”，这将在代码执⾏期间更改为读取进度百分⽐。
在框架内，插⼊另⼀个标签，该标签将不包含⽂本，⽽是充当滚动条。
这是通过为标签内部着⾊并逐渐调整其⼤⼩来执⾏的，随着宏的执⾏，它会越来越⼤。
标签的属性可能是：BackColor– &H00C00000& (蓝⾊)，BackStyle –1-fmBackStyleOpaque，BorderColor–&H80000006& (灰⾊)，Height – 30，SpecialEffect –1-fmSpecialEffectRaised，Width –18。
结果如下图3所⽰。
图32.编写⽤户窗体代码双击⽤户窗体进⼊其代码模块，在UserForm_Activate事件中，输⼊代码。
自制进度条控件(vb)
立体
End Enum
'功能:初始化
'说明:
Private Sub UserControl_Initialize()
End Sub
'功能:为每个控件初始化缺省属性
'说明:当一个控件被添加到窗体中时,此事件被触发
Private Sub UserControl_InitProperties()
Call PropBag.WriteProperty("FillColor", oFillColor)
Call PropBag.WriteProperty("BorderStyle", BorderStyle, 1)
Call PropBag.WriteProperty("CaptionStyle", CaptionStyle, 3)
'功能:取得控件状态
'说明:
Public Property Get Enabled() As Boolean
Enabled = picProgress.Enabled
End Property
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
On Error Resume Next
Appearance = PropBag.ReadProperty("Appearance", picProgress.Appearance)
FillColor = PropBag.ReadProperty("FillColor", oFillColor)
VB进度条的编写
VB进度条制作方法VB ProgressBar控件进度条：Private Sub Command1_Click()Dim counter As IntegerDim workarea(25000) As StringProgressBar1.Min = LBound(workarea)ProgressBar1.Max = UBound(workarea)ProgressBar1.Visible = TrueProgressBar1.Value = ProgressBar1.MinFor counter = LBound(workarea) To UBound(workarea)workarea(counter) = "initial value" & counterProgressBar1.Value = counterNext counterEnd Sub各位看官，直接看下面：TEXT控件进度条：Option ExplicitDim i As IntegerPrivate Sub Form_Load()Timer1.Enabled = TrueText2.Width = (Form1.Width / 100)End SubPrivate Sub Timer1_Timer()'进度条设置Text2.Width = Text2.Width + (Form1.Width / 100)If (Text2.Width / Form1.Width) > 1 ThenForm2.Show '载入主画面Unload MeEnd IfEnd SubLmage控件进度条：Option ExplicitDim i As IntegerPrivate Sub Form_Load()JDT.Top = Lab.TopJDT.Width = (Lab.Width / 100)End SubPrivate Sub Timer1_Timer()'进度条设置JDT.Width = JDT.Width + (Lab.Width / 100)If (JDT.Width / Lab.Width) > 1 ThenForm1.Show '载入主画面Unload MeEnd IfEnd SubPicture控件进度条：'例子需以下控件： 'Command1、Command2、Picture1：都采用默认属性设置Dim ctEsc As BooleanPrivate Sub Form_Load()'初始化控件Picture1.AutoRedraw = TrueCommand1.Caption = "滚动条例子": Command2.Caption = "取消"End SubPrivate Sub Command1_Click()Dim I As Long, S As LongctEsc = FalseS = 1000For I = 1 To SMe.Cls: Me.Print "显示：" & IJinDuTiao I / S, "0.0" '显示进度条：进度,显示格式（即小数数位）DoEventsIf ctEsc Then Me.Print "已取消": Exit SubNextMe.Print "完毕"End SubPrivate Sub Command2_Click()ctEsc = TrueEnd SubPrivate Sub JinDuTiao(Bi As Single, Optional nFormt As String = "0")Dim W As Long, H As Long, nStr As StringStatic UpBi As StringnStr = Format(Bi * 100, nFormt)If Val(nStr) >= "100" Then nStr = 100If UpBi = nStr Then Exit SubUpBi = nStrW = Picture1.ScaleWidth: H = Picture1.ScaleHeightPicture1.ClsPicture1.DrawMode = 13nStr = nStr & " %"Picture1.CurrentX = (W - Picture1.TextWidth(nStr)) * 0.5Picture1.CurrentY = (H - Picture1.TextHeight(nStr)) * 0.5Picture1.Print nStrPicture1.DrawMode = 14Picture1.Line (0, 0)-(W * Bi, H), &HFF0000, BFPicture1.RefreshEnd SubShape控件进度条：需要用到的控件: 'Command1、Command2、Label1、Label2、Shape1Dim ctEsc As BooleanPrivate Sub Form_Load()'初始化控件Command1.Caption = "滚动条例子": Command2.Caption = "取消"Label1.BorderStyle = 1: Label1.Caption = "0%"Label1.Alignment = 2: Label1.Height = Me.TextHeight("A") * 1.5Shape1.FillStyle = 0: Shape1.FillColor = &HFF0000: Shape1.DrawMode = 14Shape1.Move Label1.Left, Label1.Top, 30, Label1.Height - Screen.TwipsPerPixelY * 2Shape1.ZOrderEnd SubPrivate Sub Command1_Click()Dim I As Long, S As LongctEsc = FalseS = 1000For I = 1 To SMe.Cls: Me.Print "显示：" & IJinDuTiao I / S, "0.0" '显示进度条：进度,显示格式（即小数数位）DoEventsIf ctEsc Then Me.Print "已取消": Exit SubNextMe.Print "完毕"End SubPrivate Sub Command2_Click()ctEsc = TrueEnd SubPrivate Sub JinDuTiao(Bi As Single, Optional nFormt As String = "0")Label1.Caption = Int(Bi * 100) & "%"Shape1.Width = Bi * Label1.WidthEnd Sub。
用VB实现动态显示操作进度程序
用VB实现动态显示操作进度程序作者：不详来源于：中国VB网发布时间：2005-12-2凡是用过Windows的用户都非常熟悉Windows安装程序所提供的界面,即随着安装盘文件拷贝到硬盘,有一蓝色的水平尺随着百分数的增加而不断增加,当百分数达到50%时,原为白底黑字显示百分比,变成蓝底白字显示,水平尺动态显示工作进度的动感非常强。
如何在自己的应用程序加入显示动态操作进度的功能,笔者在VB编程工作中总结出两种方法。
1.方法一:建立两个图片框,这两个图片框的大小和位置都相同。
将一个设置为可见,白色背景和黑色前景。
另一个设置为不可见,蓝色背景和白色前景, AUTODRAW为TURE。
将不可见图片框中的蓝色位图通过Windows API中的BITBLT函数拷贝到可见的图片框中。
两个图片框中输出百分数的位置相同。
①在目标文件列表(OBJECT)中选择GENERAL,在过程列表(PROC)中选择DECLARATIONS(声明),进入窗体级代码定义窗口输入:DECLARE FUNCTION BITBLT% LIB "GDI"(BYVAL DESTDC%,BYV AL X%,BYV AL Y%,BYV AL W %BYVAL H%,BYV AL SRCDC%,BYVAL XSRC%,BYV AL YSRC%,BYV AL RASTEROP&)CONST SRCCOPY = &HCC0020②建立一个计时器,设置每隔五毫秒使水平尺增加1%。
输入计时器的程序代码:SUB TIMER1_TIMER ()STATIC COUNT AS INTEGERCOUNTS!=COUNT/100PERCENT$ = FORMA T(COUNTS!,"0%")P1.PRINT PERCENT$ `显示百分数.P1是可见框的控制名称.P2.PRINT PERCENT$ `显示百分数.P2是不可见框的控制名称.R% = BITBLT(P1.HDC,0,0,P2.WIDTH*COUNTS!,P2.HEIGHT,P2.HDC,0,0,SRCCOPY)COUNT = COUNT +IF COUNT = 100 THENCOUNT = 0`计数清零END IFEND SUB这种方法实现起来太繁琐且运行效果表现为水平尺的动感强,但缺乏立体美感,所以笔者只提供了程序代码的主要部分,下面将着重介绍方法二。
VB中打造个性进度条
简介UpsUpsVB的第三方控件ccrpProgressBar是一个进度条的控件，可以有多种形态供选择。
比起VB 中自带的进度条控件ProgressBar更有个性。
UpsUps使用实例:UpsUps用ccrpProgressBar制作各式各样的进度条UpsUps在VB中自带了一个进度条控件ProgressBar，但功能简单。
我向大家推荐一个VB的第三方进度条控件ccrpProgressBar。
该控件功能强大，有多种形态供选择，而且只需要简单的设置控件的属性就能实现,非常的好用。
下面通过一个例子向大家介绍该控件的用法。
UpsUps（1）加载控件UpsUps启动Visual Basic 6.0，创建一个工程并保存为"工程1.vbp"，同时产生一个名为"Form1"的窗口。
在工具箱的空白处单击鼠标右键，从弹出的快捷菜单中启动"部件"窗口，如图1所示。
UpsUpsUps图1Ups点击"浏览"按钮，从存放ccrpProgressBar控件的文件夹中找到ccrpprg.o cx文件。
UpsUps点击"应用"后ccrpProgressBar控件就添加到工具箱中。
如图2。
Ups UpsUps图2Ups（2）设计窗体和控件UpsUps向窗体中添加9个ccrpProgressBar控件和一个Timer控件。
如图3。
Ups UpsUps图3Timer控件属性页的设置如图4所示。
Interval的值设置为100，与ccrpP rogressBar控件的默认值一致。
Enabled设置为False。
UpsUpsUps图4Ups（3） ccrpProgressBar控件的主要属性UpsUps·Max:最大值。
默认100。
Ups·Min:最小值。
默认0。
Ups·Value:进度条的当前值。
Ups·Alig nment：显示表示进度的文字的位置。
VB编写进度条
VB 编写进度条已经发展很久了，也有很多好方法。
VB 自带的进度条很难看，一般不用，要用的话，代码如下：Private Sub Command1_Click() Dim counter As Integer Dim workarea(25000) As String ProgressBar1.Min = LBound(workarea) ProgressBar1.Max = UBound(workarea) ProgressBar1.Visible = TrueProgressBar1.Value = ProgressBar1.Min For counter = LBound(workarea) To UBound(workarea)workarea(counter) = "initial value" & counter ProgressBar1.Value = counter Next counter End Sub各位看官，直接看下面：Text 实现进度条：Option Explicit Dim i As IntegerPrivate Sub Form_Load() Timer1.Enabled = TrueText2.Width = (Form1.Width / 100) End SubPrivate Sub Timer1_Timer() '进度条设置Text2.Width = Text2.Width + (Form1.Width / 100) If (Text2.Width / Form1.Width) > 1 Then Form2.Show '载入主画面 Unload Me End If End SubImage 进度条：Option Explicit Dim i As IntegerPrivate Sub Form_Load()JDT.Top = Lab.TopJDT.Width = (Lab.Width / 100) End SubPrivate Sub Timer1_Timer() '进度条设置JDT.Width = JDT.Width + (Lab.Width / 100) If (JDT.Width / Lab.Width) > 1 Then Form1.Show '载入主画面 Unload Me End If End Sub那么更换N 个image 就会有N 个进度条演示，下面示图，大家自己试试。