Subroutine unexpectedly ends when a Workbook is cl

2019-08-03 01:58发布

my problem today is a part of a subroutine that inexplicably breaks its execution when a Workbook is closed.
I have written the following code:

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

Options is a form which I need in order to access data for the PolarCharts and Auswertung. These Subs are correctly executed (I know that because the data they save is correct too).

I tried deleting the .ScreenUpdating and .DisplayAlerts commands, as well as the Unload thinking that they could bugging something, but the result hasn't changed.

Know also that the Workbook I'm closing contains NO CODE at all (and nothing else addresses a ".Close" so it's impossible that something is executed on the .Close event).

Below my "Options" code:

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

Apparently when I Close CalcBook, it triggers the UserForm_Terminate event from Options which Ends all the code! How do I avoid this?

2条回答
孤傲高冷的网名
2楼-- · 2019-08-03 02:36

Just remove the statement End bacause End causes the abrupt end of code execution.

I see End in the Cancel and Terminate event handlers. If you have it on other places, remove it es well.

If you need exit from a method then use Exit Sub.

Why: because End work that way. Read e.g. this post: http://www.vbforums.com/showthread.php?511766-Classic-VB-Why-is-using-the-End-statement-(or-VB-s-quot-stop-quot-button)-a-bad-idea.

If you need stop code from execution use If-condition or even Exit Sub but avoid using End for it.

查看更多
祖国的老花朵
3楼-- · 2019-08-03 02:47

Try

Workbooks("CalcBook").Close savechanges:=False

I suspect that both error alerts and indications of an error on the screen are being suppressed

查看更多
登录 后发表回答