Warning: file_get_contents(/data/phpspider/zhask/data//catemap/5/excel/25.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Vba 子例程在工作簿关闭时意外结束_Vba_Excel_Subroutine_Userform - Fatal编程技术网

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的值,以确定它是否已被取消。那你就不需要结束了。