Vba 子例程在工作簿关闭时意外结束
我今天的问题是一个子例程的一部分,它在工作簿关闭时莫名其妙地中断了执行。 我编写了以下代码:Vba 子例程在工作簿关闭时意外结束,vba,excel,subroutine,userform,Vba,Excel,Subroutine,Userform,我今天的问题是一个子例程的一部分,它在工作簿关闭时莫名其妙地中断了执行。 我编写了以下代码: Public Const Pi As Double = 3.14159265358979 Public Const Rad As Double = Pi / 180 Public CalcBook As Workbook Public FilePath As String, Files() As String Public FreqArray() As Integer Sub Main() Dim
Public Const Pi As Double = 3.14159265358979
Public Const Rad As Double = Pi / 180
Public CalcBook As Workbook
Public FilePath As String, Files() As String
Public FreqArray() As Integer
Sub Main()
Dim ChooseFolder As Object, FilePath As String, StrFile As String
Dim i As Integer, j As Integer, k As Integer, x As Integer
Dim DirNum As Integer, HNum As Integer, VNum As Integer
Dim DirColShift As Integer, HColShift As Integer, VColShift As Integer
Dim TheStart As Date, TheEnd As Date, TotalTime As Date
Set ChooseFolder = Application.FileDialog(msoFileDialogFolderPicker)
With ChooseFolder
.AllowMultiSelect = False
.Title = "Please choose a folder containing .txt files"
If .Show = -1 Then
FilePath = .SelectedItems(1) & "\"
Else
Set ChooseFolder = Nothing
Exit Sub
End If
End With
Set ChooseFolder = Nothing
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayStatusBar = False
' Stores only files containing an AntennaName + "_T" + any number of characters + "_?_?45.xls" string
' (where "?" is a single character and "*" is any number). Checks if the number of files is correct too.
StrFile = Dir(FilePath & "*_T*_?_?45.txt")
Do While Len(StrFile) > 0
ReDim Preserve Files(i)
Files(i) = FilePath & StrFile
i = i + 1
StrFile = Dir
Loop
If Not (UBound(Files) + 1) / 6 = Int((UBound(Files) + 1) / 6) Then GoTo FileError
For i = 0 To UBound(Files)
Select Case Right(Files(i), 9)
Case "D_+45.txt", "D_-45.txt"
DirNum = DirNum + 1
Case "H_+45.txt", "H_-45.txt"
HNum = HNum + 1
Case "V_+45.txt", "V_-45.txt"
VNum = VNum + 1
End Select
Next
If Not (DirNum / 2 = Int(DirNum / 2) And HNum / 2 = Int(HNum / 2) And VNum / 2 = Int(VNum / 2) And DirNum = HNum And HNum = VNum) Then
FileError:
MsgBox "Failed to properly load files. Looks like a wrong number of them is at dispose", vbCritical, "Check the import-files"
Exit Sub
End If
' Imports files in Excel for better data access
Set CalcBook = Application.Workbooks.Add
' FROM HERE ON THE DATA IS PROCESSED IN ORDER TO OBTAIN AN EXCEL WORKBOOK WITH 3 SHEETS CALLED "Directivity", "Horizontal" and "Vertical".
Application.ScreenUpdating = True
Options.Show
TheStart = Now
Application.ScreenUpdating = False
If Options.OnlyEval = False Then PolarCharts
If Options.OnlyCharts = False Then Auswertung
Application.DisplayAlerts = False
CalcBook.Close savechanges:=False
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Set CalcBook = Nothing
TheEnd = Now
TotalTime = TheEnd - TheStart
MsgBox Format(TotalTime, "HH:MM:SS"), vbInformation, "Computing Time"
Unload Options
End Sub
选项是我访问PolarCharts和Auswertung数据所需的表单。我知道这些SUB是正确执行的,因为它们保存的数据也是正确的
我尝试删除.screenUpdated和.DisplayAlerts命令,以及Unload命令,认为它们可能会监听某些东西,但结果没有改变
还要知道,我要关闭的工作簿根本不包含任何代码,并且没有任何其他内容涉及.Close,因此不可能对.Close事件执行某些操作
下面是我的选项代码:
Private Sub Cancel_Click()
End
End Sub
Private Sub UserForm_Terminate()
End
End Sub
Private Sub Ok_Click()
If Me.OnlyCharts = False Then
ReDim SubFreq(4)
If Not (Me.Start1.ListIndex = -1 And Me.Stop1.ListIndex = -1) Then SubFreq(0) = Me.Start1.List(Me.Start1.ListIndex) & "-" & Me.Stop1.List(Me.Stop1.ListIndex)
If Not (Me.Start2.ListIndex = -1 And Me.Stop2.ListIndex = -1) Then SubFreq(1) = Me.Start2.List(Me.Start2.ListIndex) & "-" & Me.Stop2.List(Me.Stop2.ListIndex)
If Not (Me.Start3.ListIndex = -1 And Me.Stop3.ListIndex = -1) Then SubFreq(2) = Me.Start3.List(Me.Start3.ListIndex) & "-" & Me.Stop3.List(Me.Stop3.ListIndex)
If Not (Me.Start4.ListIndex = -1 And Me.Stop4.ListIndex = -1) Then SubFreq(3) = Me.Start4.List(Me.Start4.ListIndex) & "-" & Me.Stop4.List(Me.Stop4.ListIndex)
If Not (Me.Start5.ListIndex = -1 And Me.Stop5.ListIndex = -1) Then SubFreq(4) = Me.Start5.List(Me.Start5.ListIndex) & "-" & Me.Stop5.List(Me.Stop5.ListIndex)
If (Me.Start1 = "" And Me.Start2 = "" And Me.Start3 = "" And Me.Start4 = "" And Me.Start5 = "" And Me.Stop1 = "" And Me.Stop2 = "" And Me.Stop3 = "" And Me.Stop4 = "" And Me.Stop5 = "") _
Or Me.Start1.Value > Me.Stop1.Value Or Me.Start2.Value > Me.Stop2.Value Or Me.Start3.Value > Me.Stop3.Value Or Me.Start4.Value > Me.Stop4.Value Or Me.Start5.Value > Me.Stop5.Value _
Or (Me.Start1.ListIndex = -1 And Me.Stop1.ListIndex >= 0) Or (Me.Start2.ListIndex = -1 And Me.Stop2.ListIndex >= 0) Or (Me.Start3.ListIndex = -1 And Me.Stop3.ListIndex >= 0) Or (Me.Start4.ListIndex = -1 And Me.Stop4.ListIndex >= 0) Or (Me.Start5.ListIndex = -1 And Me.Stop5.ListIndex >= 0) _
Or (Me.Start1.ListIndex >= 0 And Me.Stop1.ListIndex = -1) Or (Me.Start2.ListIndex >= 0 And Me.Stop2.ListIndex = -1) Or (Me.Start3.ListIndex >= 0 And Me.Stop3.ListIndex = -1) Or (Me.Start4.ListIndex >= 0 And Me.Stop4.ListIndex = -1) Or (Me.Start5.ListIndex >= 0 And Me.Stop5.ListIndex = -1) Then
MsgBox("Please select correctly the frequency ranges - Maybe Start > Stop, one of those was not properly inserted, or the fields are blank", vbExclamation, "Frequency choice error")
GoTo hell
End If
For i = 0 To 4
If Not SubFreq(i) = "" Then j = j + 1
Next i
j = j - 1
ReDim Preserve SubFreq(j)
End If
Me.Hide
hell:
End Sub
Private Sub UserForm_Initialize()
Dim i As Byte
Me.StartMeas = Date
Me.StopMeas = Date
Me.Worker.AddItem "lol"
Me.Worker.AddItem "rofl"
Me.Worker.ListIndex = 0
For i = LBound(FreqArray) To UBound(FreqArray)
Me.Start1.AddItem FreqArray(i)
Me.Start2.AddItem FreqArray(i)
Me.Start3.AddItem FreqArray(i)
Me.Start4.AddItem FreqArray(i)
Me.Start5.AddItem FreqArray(i)
Me.Stop1.AddItem FreqArray(i)
Me.Stop2.AddItem FreqArray(i)
Me.Stop3.AddItem FreqArray(i)
Me.Stop4.AddItem FreqArray(i)
Me.Stop5.AddItem FreqArray(i)
Next i
Me.Start1.ListIndex = 0
Me.Stop1.ListIndex = Me.Stop1.ListCount - 1
End Sub
显然,当我关闭CalcBook时,它会从选项触发UserForm_Terminate事件,从而结束所有代码!如何避免这种情况?试试看
Workbooks("CalcBook").Close savechanges:=False
我怀疑屏幕上的错误警报和错误指示都被抑制了只需删除End语句,因为End导致代码执行突然结束
我在Cancel和Terminate事件处理程序中看到End。如果你把它放在其他地方,把它取下来
如果需要退出某个方法,请使用exit Sub
为什么:因为这样结束工作。阅读此帖子:
如果需要停止代码的执行,请使用“如果条件”或“退出”子项,但避免使用“结束”子项。无法工作:没有具有CalcBook名称的工作簿。我之前将Calcbook设置为一个特定的新工作簿。唯一的问题是:如果选项处理取消单击或用户窗体终止,我无法停止Main的执行。问题本身在于UserForm_Terminate,因为当我关闭而不保存工作簿时,会调用UserForm_Terminate,我不知道为什么。我确实需要所有的代码来结束,如果在你发布的代码中点击用户表单上的X,我在“Main”中没有看到任何“stop”?在处理程序的“Click”和“Terminate”中,没有代码例外“End”或调用“卸载选项”时应调用“终止”。我看不到“CalcBook”和“Options”表单之间有任何关系,或者有任何关系。所以我也很困惑。不知何故,代码从未到达卸载选项,有趣的是,在CalcBook中绝对没有代码!因此,on事件卸载触发器不能是mistake@Noldor130884,将公共变量添加到名为Result的选项中。如果选项被取消,则让Result=False,否则将其设置为True。检查Main中Result的值,以确定它是否已被取消。那你就不需要结束了。