ExcelVBA代码实例大全.docxVIP

ExcelVBA代码实例大全

vba

Sub带进度条的循环示例()

DimtotalStepsAsInteger

DimcurrentStepAsInteger

DimprogressPercentAsSingle

DimwsAsWorksheet

DimprogressBarAsShape

Setws=ActiveSheet

totalSteps=100总步骤数，根据实际循环次数修改

创建一个简单的进度条背景（矩形）

OnErrorResumeNext如果形状已存在则删除

ws.Shapes(ProgressBarBg).Delete

ws.Shapes(ProgressBarFill).Delete

OnErrorGoTo0

绘制进度条背景

SetprogressBar=ws.Shapes.AddShape(msoShapeRectangle,100,100,300,20)位置和大小：Left,Top,Width,Height

progressBar.Name=ProgressBarBg

progressBar.Fill.ForeColor.RGB=RGB(200,200,200)灰色背景

progressBar.Line.Visible=msoFalse

绘制进度条填充部分（初始宽度为0）

SetprogressBar=ws.Shapes.AddShape(msoShapeRectangle,100,100,0,20)

progressBar.Name=ProgressBarFill

progressBar.Fill.ForeColor.RGB=RGB(0,150,0)绿色填充

progressBar.Line.Visible=msoFalse

模拟一个耗时的循环任务

ForcurrentStep=1TototalSteps

这里是实际的循环处理代码，此处用DoEvents和延时模拟

DoEvents允许Excel响应其他事件，如进度条更新

Application.WaitNow+TimeValue(00:00:00.05)短暂延时，仅作演示

更新进度条

progressPercent=currentStep/totalSteps

ws.Shapes(ProgressBarFill).Width=300*progressPercent300是背景条的总宽度

更新进度百分比文本（可选）

OnErrorResumeNext

ws.Shapes(ProgressText).Delete

OnErrorGoTo0

ws.Shapes.AddTextbox(msoTextOrientationHorizontal,420,100,60,20).Name=ProgressText

ws.Shapes(ProgressText).TextFrame2.TextRange.Characters.Text=Format(progressPercent,0%)

ws.Shapes(ProgressText).TextFrame2.TextRange.Font.Size=12

ws.Shapes(ProgressText).Line.Visible=msoFalse

ws.Shapes(ProgressText).Fill.Visible=msoFalse

NextcurrentStep

完成后清理进度条

ws.Shapes(ProgressBarBg).Delete

ws.Shapes(ProgressBarFill).Delete

ws.Shapes(ProgressText).Delete