Question

我正在尝试为访问表单实现进度条。调用方法时，它会抛出一个错误，说明用户定义的类型没有定义，并且Form_ProgressBar中有错误标记

Private Sub exampleCall1() ' example call for using progress bar with a looping process  
    Dim pbar As Form_ProgressBar
    Dim i As Long Dim steps As Long 
    steps = 100000    
    ' create new instance of Progress Bar  
    Set pbar = New Form_ProgressBar  
    With pbar  ' #of steps, Mode, Caption  
        .init steps, PBarMode_Percent, "Hey, I'm working here!" 
        For i = 1 To steps  
            ' do something in a loop  
            ' update progress  
            .CurrentProgress = i  
        Next i 
    End With 
    Set pbar = Nothing
End Sub

以下是调用进度条方法的方法

Public Sub ImportExcelfile(tblname As String, drpdwn As String)

Dim ExcelApp As New Excel.Application
Dim ExcelBook As New Excel.Workbook
Dim rng As Excel.Range
Dim rngDefine As Excel.Range

Dim objDialog As Object
Set objDialog = Application.FileDialog(3)
Dim strXls As String
On Error Resume Next

'Dialog box to select the excel file
     With objDialog
     .Title = "Select the Excel file to import"
     .AllowMultiSelect = False
     .Filters.Clear
     .Filters.Add "Excel Files macros enabled", "*.xlsm", 1
     .Filters.Add "All Files", "*.*", 2
     .Filters.Add "Excel Files", "*.xlsx", 3

If .Show = -1 Then
StrFileName = .SelectedItems(1)

     ExcelApp.Visible = False

     Set ExcelBook = ExcelApp.Workbooks.Open(StrFileName, False, True)

     Set rngDefine = ExcelBook.Worksheets("sheet1").Range("A1:AJ1")

     If IsError(ExcelApp.Match("text1", rngDefine, 0)) Then

        DoCmd.TransferSpreadsheet transfertype:=acImport, _
        tablename:=drpdwn, _
        FileName:=StrFileName, Hasfieldnames:=True, _
        Range:="Sheet1!I:J", SpreadsheetType:=5


        DoCmd.TransferSpreadsheet transfertype:=acImport, _
        tablename:=tblname, _
        FileName:=StrFileName, Hasfieldnames:=True, _
        Range:="Sheet1!A:FK", SpreadsheetType:=5

     Else

MsgBox "File you trying to import contains one heading 'text1' in the first 
row.Please Delete it before importing"

End If

End With
  ExcelBook.Close SaveChanges:=False
 Set ExcelBook = Nothing
ExcelApp.Quit
Set ExcelApp = Nothing

End sub

需要时间处理的代码是打开工作簿并设置范围并检查Excel工作表中的特定文本1。在那我想显示progess栏

    Set ExcelBook = ExcelApp.Workbooks.Open(StrFileName, False, True)

    Set rngDefine = ExcelBook.Worksheets("sheet1").Range("A1:AJ1")

    If IsError(ExcelApp.Match("text1", rngDefine, 0)) Then

Answer 1

如果您已重命名进度条表单，则需要更改对象类型。

Dim pbar as Form_YourNameHere
Set pbar = Neew Form_YourNameHere

由于代码中没有循环，您需要手动进行一些数学运算并自行增加pbar的CurrentProgress属性。我已修改您的代码来执行此操作。没有多少步骤，所以进展将会＃34;跳跃＆＃34;一点点。

Public Sub ImportExcelfile(tblname As String, drpdwn As String)

Dim ExcelApp As New Excel.Application
Dim ExcelBook As New Excel.Workbook
Dim rng As Excel.Range
Dim rngDefine As Excel.Range

Dim objDialog As Object
Set objDialog = Application.FileDialog(3)
Dim strXls As String

Dim pbar As Form_ProgressBar 'or whatever you named it

On Error Resume Next

'Dialog box to select the excel file
With objDialog
    .Title = "Select the Excel file to import"
    .AllowMultiSelect = False
    .Filters.Clear
    .Filters.Add "Excel Files macros enabled", "*.xlsm", 1
    .Filters.Add "All Files", "*.*", 2
    .Filters.Add "Excel Files", "*.xlsx", 3

If .Show = -1 Then
    StrFileName = .SelectedItems(1)

    ExcelApp.Visible = False

    Set pbar = New Form_ProgressBar 'again, whatever you named the form
    'There are 5 distinct steps to this code.
    pbar.init 5, PBarMode_Percent

    Set ExcelBook = ExcelApp.Workbooks.Open(StrFileName, False, True)

   'increment pbar
    pbar.CurrentProgress = 1 '20%

    Set rngDefine = ExcelBook.Worksheets("sheet1").Range("A1:AJ1")

    pbar.CurrentProgress = 2 '40%
    If IsError(ExcelApp.Match("text1", rngDefine, 0)) Then

        DoCmd.TransferSpreadsheet transfertype:=acImport, _
        tablename:=drpdwn, _
        fileName:=StrFileName, Hasfieldnames:=True, _
        Range:="Sheet1!I:J", SpreadsheetType:=5

        'increment pbar
        pbar.CurrentProgress = 3 '60%

        DoCmd.TransferSpreadsheet transfertype:=acImport, _
        tablename:=tblname, _
        fileName:=StrFileName, Hasfieldnames:=True, _
        Range:="Sheet1!A:FK", SpreadsheetType:=5

        'increment pbar
        pbar.CurrentProgress = 4 '80%
    Else
        ' remove progress bar on "error"
        Set pbar = Nothing

        MsgBox "File you trying to import contains one heading 'text1' in the first row.Please Delete it before importing"

    End If

End With
ExcelBook.Close SaveChanges:=False
Set ExcelBook = Nothing
xcelApp.Quit
Set ExcelApp = Nothing

'all done
pbar.CurrentProgress = 5 '100%
Set pbar = Nothing
End Sub

对于任何绊倒这个的人。 OP正在实施我最初在此发布的MS Access ProgressBar表单。 http://christopherjmcclellan.wordpress.com/2014/03/08/progress-bar-for-ms-access/

使用ProgressBar访问vba时，用户定义的类型未定义错误

1 个答案: