如果rpdate = False,则行继续崩溃Excel

时间:2018-10-29 20:33:56

标签: excel vba excel-vba

我有一行代码不断使Excel崩溃。

Public Sub Main_Runtime()
rpdate = ToolPack.getDateFromInput()
If rpdate = False Then
    MsgBox ("Macro Cancelled")
    Exit Sub

这是我模块的一部分,但是每次我运行它时,Excel碰到“ If rpdate = False Then”行时,都会立即冻结并崩溃。我进行了一步一步的测试,并在那条线冻结了(对于某些具有此线的模块)。 在继承这些VBA项目之前,为我提供的唯一解决方法是您必须复制然后粘贴整个模块才能正常工作。执行完此操作后,除非关闭项目,否则每次运行代码都将起作用。然后,我必须重复复制和粘贴步骤,以使Excel不冻结。

编辑: 这是我必须完整复制并粘贴的特定模块:

Public Sub Main_Runtime()
rpdate = ToolPack.getDateFromInput()
If rpdate = False Then
    MsgBox ("Macro Cancelled")
    Exit Sub
End If
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'start error log
ErrorLog = Format(rpdate, "mm/dd/yy") & " KPI Started at: " & Now & vbNewLine
'Set Global Variables
Set KPIworkbook = ThisWorkbook
Set dayX = ThisWorkbook.Sheets("Day " & day(rpdate))
Set ActiveAgentTracker = getworkbook(ActiveAgentTrackerFile)
Set AgentInfo = ActiveAgentTracker.Sheets("Agent")
Set supportInfo = ActiveAgentTracker.Sheets("Support")
Set archiveInfo = ActiveAgentTracker.Sheets("Support")
Dim errormail As Outlook.MailItem
Set errormail = Outlook.Application.CreateItem(olMailItem)
On Error Resume Next
With errormail
    .Display
    .Subject = "Error Log - " & rpdate
    .Body = ""
End With
'    Set errormail = Nothing

If AgentInfo.AutoFilterMode Then AgentInfo.AutoFilter.ShowAllData

Call ResetDay(rpdate)
dayX.Visible = xlSheetVisible

Call InitOverallWrap(rpdate)
Call ImportRawCMSData(rpdate)
Call ImportOverallWrap(rpdate)
Call ImportRawProxyData(rpdate)
Call UpdateInfractionAgents(ThisWorkbook)
Call TransferInfractions(rpdate)
errormail.Body = errormail.Body & vbNewLine & ErrorLog
ErrorLog = ""

With dayX
    .AutoFilterMode = False
    .Range("A4:BW4").AutoFilter field:=2, Criteria1:="<>SLS"
    .Range("A4:BW4").AutoFilter field:=5, Criteria1:="<>"
    .Activate
    .Range("A5").Activate
    .Range("A2").Value = rpdate
End With

Call RunAgentSummary(KPIworkbook)
Call ImportAttendanceData(rpdate)
Call Import_OB_IB_QA
Call Run_ATL_Summary

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic

ActiveAgentTracker.Close savechanges:=False
KPIworkbook.Save

ErrorLog = ErrorLog & vbNewLine & "KPI Completed at: " & Now
errormail.Body = errormail.Body & vbNewLine & ErrorLog
ErrorLog = ""

Set errormail = Nothing



End Sub

0 个答案:

没有答案