以下代码中存在一些问题,这让我很生气。当Excel Workbook
自动关闭时,我无法找到代码突然结束的原因。
代码从Excel工作簿执行,其工作方式如下:
以下整个代码:
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
相关联,我仍然不明白为什么。
答案 0 :(得分:0)
由于您尚未发布完整代码 - 在调试模式下运行代码。在要仔细查看正在发生的事情的位置添加断点。使用F5运行(它将在下一个断点处停止或运行直到结束)和F8用于步进模式(移至下一行)。使用监视表来检查变量或整个IF contiodions的值,以确定代码何时应该分支或执行特定的操作。
调试模式:
是否有可能出现过去问题in this case?
根据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
替换为上述备选方案,它应该可以正常工作。