为什么Workbook.Close会触发UserForm_Terminate? - VBA

时间:2016-09-30 07:40:11

标签: excel vba excel-vba crash

以下代码中存在一些问题,这让我很生气。当Excel Workbook自动关闭时,我无法找到代码突然结束的原因。

代码从Excel工作簿执行,其工作方式如下:

  • 它打开另一个工作簿(WbLOP)
  • 创建第三个工作簿(TargetWb)
  • 将一些数据从WbLOP复制到TargetWb
  • 关闭WbLOP

以下整个代码:

Public WbLOP As Workbook, WsLop As Worksheet
Public AbtToEval As String

Sub Std_Ausw()

Dim OpenDialog As Object, FileName As String
Dim Ws As Worksheet
Dim Termin As Date
Dim TargetWb As Workbook, TargetWs As Worksheet
Dim i As Integer, j As Integer, k As Integer, w As Integer
Dim ZielCol As Integer, ZielNEWCol As Integer, PEPStatusCol As Integer, StatusAICol As Integer
Dim ActivityRow As Integer

' Asks user input file to read from
Set OpenDialog = Application.FileDialog(msoFileDialogFilePicker)
With OpenDialog
    .AllowMultiSelect = False
    .Filters.Clear
    .Filters.Add "Excel Files", "*.xls, *.xlsx, *.xlsm"
    If .Show Then
        FileName = .SelectedItems(1)
    Else
        Set OpenDialog = Nothing
        Exit Sub
    End If
End With
Set OpenDialog = Nothing

' Checks if the worksheet "LOP" is contained in the file
Set WbLOP = Application.Workbooks.Open(FileName)
For Each Ws In WbLOP.Worksheets
    If UCase(Ws.Name) = "LOP" Then
        Set WsLop = Ws
        Exit For
    End If
Next
On Error Resume Next
If WsLop.Name = "" Then
    WbLOP.Close savechanges:=False
    Set WbLOP = Nothing
    MsgBox "Fail"
    Exit Sub
End If
On Error GoTo 0

' Shows a Userform to let user decide the name of the AbtToEval
Ausw.Show

我在这里粘贴UserForm的代码:

Private Sub Cancel_Click()
    End
End Sub

Private Sub UserForm_Terminate()
    End
End Sub

Private Sub UserForm_Initialize()

Dim Abt() As String
Dim i As Integer, j As Integer, k As Integer

' Searches for the PD-Abt column
i = 1
Do Until LCase(WsLop.Cells(8, i)) = "pd-abt"
    i = i + 1
Loop

' Copies the unique Abt in an array
j = 10
ReDim Abt(0)
Abt(0) = UCase(WsLop.Cells(j, i))
Do Until IsEmpty(WsLop.Cells(j, 1))
    For k = 0 To UBound(Abt)
        If Abt(k) = UCase(WsLop.Cells(j, i)) Then
            Exit For
        Else
            If k = UBound(Abt) Then
                ReDim Preserve Abt(UBound(Abt) + 1)
                Abt(UBound(Abt)) = UCase(WsLop.Cells(j, i))
            End If
        End If
    Next
    j = j + 1
Loop

' Initializes the combo-box with the Abt names
For i = 0 To UBound(Abt)
    Me.AbtBox.AddItem Abt(i)
Next
Me.AbtBox.ListIndex = 0

End Sub

Private Sub OK_Click()
    AbtToEval = Me.AbtBox.List(Me.AbtBox.ListIndex)
    Me.Hide
End Sub

这里主要的Sub恢复了

' Opens a new workbook and copies the table from the template
Application.DisplayAlerts = False
Set TargetWb = Application.Workbooks.Add
Do Until TargetWb.Sheets.Count = 1
    TargetWb.Sheets(TargetWb.Sheets.Count).Delete
Loop
Set TargetWs = TargetWb.Sheets(1)
ThisWorkbook.Worksheets("Template").Range("A1:J3").Copy Destination:=TargetWs.Range("A1")
Application.DisplayAlerts = True
TargetWs.Range("A2") = AbtToEval

' Sets a standard limit of 4 weeks from today
Termin = DateAdd("ww", 4, Date)

' Searches for the Ziel-Datum columns
i = 1
Do Until InStr(1, LCase(WsLop.Cells(8, i)), "ziel-datum") <> 0
    i = i + 1
Loop
If InStr(1, LCase(WsLop.Cells(8, i)), "neu") <> 0 Then
    ZielNEWCol = i
    i = i + 1
    Do Until InStr(1, LCase(WsLop.Cells(8, i)), "ziel-datum") <> 0
        i = i + 1
    Loop
    ZielCol = i
Else
    ZielCol = i
    i = i + 1
    Do Until InStr(1, LCase(WsLop.Cells(8, i)), "ziel-datum") <> 0
        i = i + 1
    Loop
    ZielNEWCol = i
End If

' Searches for the status columns
i = 1
Do Until InStr(1, LCase(WsLop.Cells(8, i)), "pep status") <> 0
    i = i + 1
Loop
PEPStatusCol = i
i = 1
Do Until InStr(1, LCase(WsLop.Cells(8, i)), "status ai") <> 0
    i = i + 1
Loop
StatusAICol = i

' Searches for the activities to do
i = 0
j = 0
Do Until IsEmpty(WsLop.Cells(9 + i, 1))
    If Not WsLop.Cells(9 + i, PEPStatusCol) = "akt" Then GoTo Go_Forth
    If WsLop.Cells(9 + i, StatusAICol) = "ges" Then GoTo Go_Forth
    If IsEmpty(WsLop.Cells(9 + i, ZielNEWCol)) Then
        If CDate(WsLop.Cells(9 + i, ZielCol)) > Termin Then
            GoTo Go_Forth
        Else
            ActivityRow = 9 + i
        End If
    Else
        If CDate(WsLop.Cells(9 + i, ZielNEWCol)) > Termin Then
            GoTo Go_Forth
        Else
            ActivityRow = 9 + i
        End If
    End If
    ThisWorkbook.Worksheets("Template").Range("A4:J4").Copy Destination:=TargetWs.Cells(4 + j, 1)
    For w = 1 To 10
        k = 1
        Do Until TargetWs.Cells(3, w) = WsLop.Cells(8, k)
            k = k + 1
        Loop
        TargetWs.Cells(4 + j, w) = WsLop.Cells(ActivityRow, k)
    Next
    j = j + 1
Go_Forth:
    i = i + 1
Loop

' If TargetSheet is empty then shows only a message
If IsEmpty(TargetWs.Cells(4, 1)) Then
    Application.DisplayAlerts = False
    TargetWb.Close savechanges:=False
    Application.DisplayAlerts = True
    MsgBox "We have no bananas before " & Format(Termin, "dd.mm.yyyy") & " for the " & AbtToEval & "!", vbInformation, AbtToEval & " out of bananas"
Else
    ' If the activity is in the past, it is marked in red
    i = 4
    Do Until IsEmpty(TargetWs.Cells(i, 1))
        If IsEmpty(TargetWs.Cells(i, 2)) Then
            If CDate(TargetWs.Cells(i, 1)) <= Date Then TargetWs.Range(Cells(i, 1).Address(0, 0), Cells(i, 10).Address(0, 0)).Font.ColorIndex = 3
        Else
            If CDate(TargetWs.Cells(i, 2)) <= Date Then TargetWs.Range(Cells(i, 1).Address(0, 0), Cells(i, 10).Address(0, 0)).Font.ColorIndex = 3
        End If
        i = i + 1
    Loop
    ' Fixes the visual and adds filters
    TargetWs.Range("A4").Select
    ActiveWindow.FreezePanes = True
    TargetWs.Range("A3:J3").AutoFilter
    TargetWs.Cells.EntireColumn.AutoFit
End If

' Ending
Set TargetWs = Nothing
Set TargetWb = Nothing
Set WsLop = Nothing
WbLOP.Close savechanges:=False
Set WbLOP = Nothing

End Sub

我设法在if WbLOP Is Nothing Then End事件中找到了与UserForm_Terminate一起使用的变通方法,正如Workbook.Close事件触发了一些评论/答案所指出的那样,但显然我是执行代替TargetWb关闭的代码,没有任何反应 该活动基本上与WbLOP.Close相关联,我仍然不明白为什么。

1 个答案:

答案 0 :(得分:0)

由于您尚未发布完整代码 - 在调试模式下运行代码。在要仔细查看正在发生的事情的位置添加断点。使用F5运行(它将在下一个断点处停止或运行直到结束)和F8用于步进模式(移至下一行)。使用监视表来检查变量或整个IF contiodions的值,以确定代码何时应该分支或执行特定的操作。

调试模式:

Code debug

修改

是否有可能出现过去问题in this case

enter image description here

编辑2

根据MSDN

MSDN

卸载对象时会触发Terminate事件。第一个工作簿关闭工作正常,因为表单尚未加载。如果在执行工作簿关闭时表单是该工作簿的对象,则卸载表单并触发UserForm_Terminate,从而导致END - 代码停止执行。

显然,这将在表单的每个闭包上执行(甚至隐藏它)

Private Sub userform_terminate()
'Code 
End Sub

您应该使用它来检测用户何时通过x按钮关闭它:

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = 0 Then ' =0 or = vbFormControlMenu 
         'Code 
    End If
End Sub

然后它只会在用户关闭表单时执行,但不会在表单卸载时执行,因此请将userform_terminate替换为上述备选方案,它应该可以正常工作。