Question

我有一个宏，可以根据工作簿中的数据表转换/创建工作表。根据数据表，可以创建3到50个新工作表。当只有三张纸的数据时，它运行得相当快，但是当我有50张新纸张的数据时，需要一些时间，我想让用户知道这个过程有多快 - 因此状态/过程栏。我使用了Ejaz'http://www.ni.com/white-paper/3995/en/#toc1并将userform和模块上传到我的工作簿。我试图将它与我的代码结合起来，看起来像这样：

Option Explicit

Sub convert_click()

Application.EnableEvents = False
Application.ScreenUpdating = False

Dim wsMaster As Worksheet, wsShift As Worksheet
Dim lRow&, mRow&
Dim shift$, person$, day$, desc$, typee$, shiftName$
Dim sRow&, sCol&
Dim oFind As Range
Dim bNedfald As Boolean, newCol$

newCol = FrontSheet.Range("FP_Column")
If newCol = "" Then
    MsgBox "Please specify column", vbCritical
    FrontSheet.Range("FP_Column").Activate
    Exit Sub
End If

LogSheet.ListObjects(1).ListColumns("Linenumber").Range(1, 1).Offset(0, 1) = newCol
LogSheet.ListObjects(1).ListColumns("Linenumber2").Range(1, 1).Offset(0, 1) = newCol

newCol = IIf(newCol = "EU", "M", "N")

' delete existing sheets before creating new one
Call deleteShiftSheets

START

Set wsMaster = ThisWorkbook.Sheets("Master")

With wsMaster
    If wsMaster.FilterMode Then wsMaster.ShowAllData
    lRow = .Cells(Rows.Count, "A").End(xlUp).row

    For mRow = 2 To lRow
        ' read data from master
        shift = Trim(.Cells(mRow, "A"))
        shiftName = IIf(.Cells(mRow, "F") = "", .Cells(mRow, "E"), .Cells(mRow, "F"))
        desc = Trim(.Cells(mRow, "B"))
        person = Trim(.Cells(mRow, "C"))
        day = Trim(.Cells(mRow, "D")) + 1
        typee = UCase(Trim(.Cells(mRow, "E")))
        sCol = person + 2
        sRow = (day * 8)

        ' get reference of existing sheet or create new one
        Set wsShift = getWorksheet(ActiveWorkbook, shift, desc)

        If InStr(1, desc, "nedfald", vbTextCompare) Then
            bNedfald = True
        End If

        If wsShift.Cells(7, sCol) = "" Then
            TemplateSheet.Range("Block").Copy
            'wsShift.Cells(7, sCol).PasteSpecial
            wsShift.Cells(7, sCol).Insert xlShiftToRight
        End If
        If wsShift.Cells(7, sCol) = "" Then wsShift.Cells(7, sCol) = person

        ' popualte data from master to shift sheet
        wsShift.Cells(sRow, sCol) = shiftName
        wsShift.Cells(sRow + 1, sCol) = .Cells(mRow, "H")  
        wsShift.Cells(sRow + 2, sCol) = .Cells(mRow, "I")    
        wsShift.Cells(sRow + 3, sCol) = .Cells(mRow, "J")    
        wsShift.Cells(sRow + 4, sCol) = .Cells(mRow, "L")    
        wsShift.Cells(sRow + 5, sCol) = .Cells(mRow, "K")
        wsShift.Cells(sRow + 6, sCol) = .Cells(mRow, newCol)    
        wsShift.Cells(sRow + 7, sCol) = .Cells(mRow, "O")    

Call modProgress.ShowProgress(0, wsShift, _
                "Excel is working on Task Number 1", False, _
                "Progress Bar Test")

    Next
End With

Call ignoreErrors
Call addButtons
Call protectSheets
Call validateRules
Call hideBlankPartStay


If Not bNedfald Then
    Call getWorksheet(ActiveWorkbook, "nedfald", "nedfald")
End If

FrontSheet.Activate
FINISH

Application.ScreenUpdating = True
Application.EnableEvents = True

''MsgBox "sheets generated", vbInformation
End Sub


' this function either retuns existing worksheet if already exists or create a new one and then return it
Function getWorksheet(wbFile, sheetName$, desc) As Worksheet
    Dim t As Worksheet
    On Error GoTo Sheet_Not_Found
    sheetName = sheetNameSafeString(sheetName)
Set getWorksheet = wbFile.Sheets(CStr(sheetName))
Exit Function

Sheet_Not_Found:
    TemplateSheet.Visible = xlSheetVisible
    ' add new shift sheet
    TemplateSheet.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    TemplateSheet.Visible = xlSheetHidden
    Set getWorksheet = ActiveSheet
    ActiveSheet.Range("ShiftName") = sheetName
    ActiveSheet.Range("Description") = desc
    ActiveSheet.Tab.ColorIndex = -4142
    ActiveSheet.Name = sheetName
' this identifies it as shift sheet.
ActiveSheet.Range("Z1") = "Shift_Sheet"
DoEvents: DoEvents

If desc = "nedfald" Then
    ActiveSheet.Shapes("shTransfer").Delete
End If
End Function

' delete existing shift sheets.
Sub deleteShiftSheets()
Dim ws As Worksheet

Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Sheets
    If ws.Range("Z1") = "Shift_Sheet" Then
        ws.Delete
    End If
Next
Application.DisplayAlerts = True
End Sub

当我运行宏时，它给了我这个错误：

“运行时错误'438'：对象不支持此属性或方法”

并突出显示以下内容：

Call modProgress.ShowProgress(0, wsShift, _
                "Excel is working on Task Number 1", False, _
                "Progress Bar Test")

我做错了什么？

（我已经在modProgress模块中使用了Ejaz代码。我应该在这里上传吗？）

THX！

Answer 1

您正在使用Worksheet object，其中函数期望任务总数和当前数字任务索引的静态零。

Call modProgress.ShowProgress(mRow, lRow, _
                "Excel is working on Task Number 1", False, _
                "Progress Bar Test")

我已在For Each...Next Statement中使用mRow和lRow来提供当前任务和任务总数。这应该足够接近，尽管你可以将两者都减少1（mRow从2开始）。

VBA中的进程栏无法正常工作

1 个答案: