Question

我已经测试并尝试在宏中实现进度条。但是不知何故，进度条没有显示，我现在正试图找出原因。

我已经在刷新模板时在加载宏的外部文件中实现了进度条和代码。此外，宏中还有一个application.screenupdate = false行。

因此，我想知道最后一行是否会影响进度栏。

我在模板本身中尝试过。进度栏显示为0％，但没有其他反应。当我取消进度条时（单击进度条右上角的“ x”），宏继续。

这是在外部脚本文件中执行的宏：

Sub vernieuwalles(mytemplate As String)
Dim workbook_Name As Variant
Dim workbookdirectory As String
Dim activewb As String
Dim i As Integer
Dim counter As Integer

  Windows(mytemplate).Activate

  On Error GoTo Err_

UserForm1.Show

  'Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual

'  Call SheetOpschonen


counter = 0
Call progress

  Call datawissen

counter = counter + 1
Call progress

  For i = 1 To Worksheets.Count
    If Worksheets(i).Name = "Output Totaal" Then Call ASW
    Next i

counter = counter + 1
Call progress


  Call dataplaatsen

counter = counter + 1
Call progress

  Call kolomtitels

counter = counter + 1
Call progress

  Call toevoegen

counter = counter + 1
Call progress

  Call maaktabel

counter = counter + 1
Call progress

  Call refreshpivots

counter = counter + 1
Call progress

If ActiveWorkbook.ReadOnly = True Then ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite

ActiveWorkbook.Application.DisplayAlerts = False

activewb = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5)

workbookdirectory = "M:\Commercie\Marktdata\IRi\Segment Ontwikkeling\"

workbook_Name = Application.GetSaveAsFilename(fileFilter:="Excel binary sheet (*.xlsb), *.xlsb", InitialFileName:=workbookdirectory & activewb)

If workbook_Name <> False Then ActiveWorkbook.SaveAs Filename:=workbook_Name, FileFormat:=50

ActiveWorkbook.ChangeFileAccess Mode:=xlReadOnly

ActiveWorkbook.Application.DisplayAlerts = True

Exit_:
  Application.StatusBar = ""
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
  Exit Sub

Err_:
  Call MsgBox(Err.Number & vbCrLf & Err.Description)
  Resume Exit_

Application.Calculation = xlCalculationAutomatic

End Sub

为了控制进度条，我有以下代码：

Sub code()

Dim pctCompl As Single

    pctCompl = counter / 7
    progress pctCompl

If pctCompl.Value = 1 Then Unload UserForm1

End Sub

Sub progress(pctCompl As Single)

    UserForm1.Text.Caption = pctCompl & "Completed"
    UserForm1.Bar.Width = pctCompl

    DoEvents
    'UserForm1.Hide
    End Sub

模板自身具有以下代码以启动脚本文件：

Option Explicit
Sub vernieuwalles()
Dim myTemplate As String: myTemplate = ActiveWorkbook.Name
Dim myTool As String: myTool = "refresh_segment_template.xlsm"


  Application.ScreenUpdating = False

  Workbooks.Open GetPath & myTool
  Application.Run myTool & "!vernieuwalles", myTemplate

  Call Windows(myTool).Close(False)

  Application.ScreenUpdating = True

End Sub

Private Function GetPath() As String
Dim myPosition As Integer
Dim myPath As String: myPath = ActiveWorkbook.Path

  myPosition = InStr(StrReverse(myPath), "\") - 1
  myPosition = Len(myPath) - myPosition

  GetPath = Mid(myPath, 1, myPosition - 1) & "\XLAM\"

End Function

我现在想知道应该从外部脚本文件还是从模板启动进度栏。因为当我从模板启动它时，什么都没有发生，只是进度条显示为0％。

用户表单也包含在外部模板文件中。该脚本运行良好，除了未显示进度栏。我找不到原因。

更新进度条的方法是受wellsr网站上的教程中编写的启发的。

进度条未由宏调用

0 个答案: