在Excel Userform中按ESC键会导致错误

问题描述 投票:-2回答:1

晚上的人,

当我在Excel用户窗体中按ESC时出现一个非常奇怪的错误:-2147417848(80010108),“自动化错误:调用的对象已与其客户端断开连接”。我可以使用On Error Resume Next等跳过错误。但是我总是留下同样奇怪的问题:Excel将拒绝关闭。我可以关闭工作簿,打开新工作簿等。但程序本身拒绝关闭,除非通过TM。有人有任何解决方案?

请注意,这只发生在我的许多用户表单中!

Option Explicit
Dim TabCheck As Boolean
Dim LastRowA As Long
Dim TitleArr() As Variant
Dim LinkArr() As Variant
Dim LastRowOldA As Long
Dim LastRowNewA As Long
Dim LastRowNewB As Long
Dim rngA As String
Dim rngB As String


'Page 1



Private Sub CommandButtonCanc_Click()

Me.Hide

End Sub

Private Sub CommandButtonOK_Click()

Call NewRow

Me.Hide

End Sub

Private Sub ListBoxOwn_Change()

Call OKEnable

End Sub

Private Sub OptionButton1_Click()

Call OKEnable

End Sub

Private Sub OptionButton2_Click()

Call OKEnable

End Sub

Private Sub OptionButton3_Click()

Call OKEnable

End Sub



Private Sub P2_ComboBoxID_Change()

If EnableEvents = False Then Exit Sub

Call ComboBoxIDChange(P2_ComboBoxID, P2_ComboBoxID.ListIndex)

End Sub

Private Sub P2_ListBoxOwn_Change()

If EnableEvents = False Then Exit Sub

Call P2_OKEnable

End Sub

Private Sub P2_TextBoxCust_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ' If right-button clicked
    If Button = 2 Then
        Call ShowPopup(Me, P2_TextBoxCust.Text, X, Y, P2_TextBoxCust)
    End If
End Sub

Private Sub P2_TextBoxDesc_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ' If right-button clicked
    If Button = 2 Then
        Call ShowPopup(Me, P2_TextBoxDesc.Text, X, Y, P2_TextBoxDesc)
    End If
End Sub

Private Sub P3_ComboBoxID_Change()

If EnableEvents = False Then Exit Sub

Call ComboBoxIDChange(P3_ComboBoxID, P3_ComboBoxID.ListIndex)

End Sub

Private Sub P3_CommandButtonRelDocMan_Click()

RelDocMan.Show

Call AcceptID

End Sub

Private Sub P3_TextBoxRelDocLink1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ' If right-button clicked
    If Button = 2 Then
        Call ShowPopup(Me, P3_TextBoxRelDocLink1.Text, X, Y, P3_TextBoxRelDocLink1)
    End If
End Sub

Private Sub P3_TextBoxRelDocLink2_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ' If right-button clicked
    If Button = 2 Then
        Call ShowPopup(Me, P3_TextBoxRelDocLink2.Text, X, Y, P3_TextBoxRelDocLink2)
    End If
End Sub

Private Sub P3_TextBoxRelDocName1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    ' If right-button clicked
    If Button = 2 Then
        Call ShowPopup(Me, P3_TextBoxRelDocName1.Text, X, Y, P3_TextBoxRelDocName1)
    End If

End Sub

Private Sub P3_TextBoxRelDocName2_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ' If right-button clicked
    If Button = 2 Then
        Call ShowPopup(Me, P3_TextBoxRelDocName2.Text, X, Y, P3_TextBoxRelDocName2)
    End If
End Sub

Private Sub P4_ComboBoxID_Change()

If EnableEvents = False Then Exit Sub

Call ComboBoxIDChange(P4_ComboBoxID, P4_ComboBoxID.ListIndex)

End Sub

Private Sub P4_CommandButtonCM_Click()

CM.Show

Call AcceptID

End Sub

Private Sub P4_TextBoxCom_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ' If right-button clicked
    If Button = 2 Then
        Call ShowPopup(Me, P4_TextBoxCom.Text, X, Y, P4_TextBoxCom)
    End If
End Sub

Private Sub P5_ComboBoxID_Change()

If EnableEvents = False Then Exit Sub

Call ComboBoxIDChange(P5_ComboBoxID, P5_ComboBoxID.ListIndex)

End Sub

Private Sub P6_ComboBoxID_Change()

If EnableEvents = False Then Exit Sub

Call ComboBoxIDChange(P6_ComboBoxID, P6_ComboBoxID.ListIndex)

End Sub

Private Sub P6_CommandButtonCanc_Click()

Me.Hide

End Sub

Private Sub P6_CommandButtonDel_Click()

Answer = MsgBox("Are you sure you want to delete task no. " & ID & "?", vbYesNo + vbQuestion, "Delete Task")
If Answer = vbNo Then Exit Sub

Call DeleteRow

Me.Hide

End Sub

Private Sub TextBoxCust_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ' If right-button clicked
    If Button = 2 Then
        Call ShowPopup(Me, TextBoxCust.Text, X, Y, TextBoxCust)
    End If
End Sub

Private Sub TextBoxDesc_Change()

Call OKEnable

End Sub




'Page 2

Private Sub P2_CommandButtonCanc_Click()

If EnableEvents = False Then Exit Sub

Me.Hide

End Sub

Private Sub P2_CommandButtonOK_Click()

If EnableEvents = False Then Exit Sub

Call P2_OK

Call AcceptID

End Sub


Private Sub P2_OptionButton1_Click()

If EnableEvents = False Then Exit Sub

Call P2_OKEnable

End Sub

Private Sub P2_OptionButton2_Change()

If EnableEvents = False Then Exit Sub

Call P2_OKEnable

End Sub

Private Sub P2_OptionButton3_Change()

If EnableEvents = False Then Exit Sub

Call P2_OKEnable

End Sub


Private Sub P2_TextBoxCust_Change()

If EnableEvents = False Then Exit Sub

Call P2_OKEnable

End Sub

Private Sub P2_TextBoxDesc_Change()

If EnableEvents = False Then Exit Sub

Call P2_OKEnable

End Sub






'Page 3



Private Sub P3_CommandButtonCanc_Click()

Me.Hide

End Sub

Private Sub P3_TextBoxRelDocName1_Change()

If EnableEvents = False Then Exit Sub

If P3_TextBoxRelDocName1 = "" Or P3_TextBoxRelDocName1 = "Name" Then
    P3_TextBoxRelDocName2.Visible = False
    P3_TextBoxRelDocLink2.Visible = False
    Exit Sub
Else
    P3_TextBoxRelDocName2.Visible = True
    P3_TextBoxRelDocLink2.Visible = True

End If

If P3_OkEnable = False Then P3_CommandButtonOK.Enabled = False
If P3_OkEnable = True Then P3_CommandButtonOK.Enabled = True

End Sub

Private Sub P3_TextBoxRelDocLink1_Change()

If EnableEvents = False Then Exit Sub

If P3_OkEnable = False Then
    P3_CommandButtonOK.Enabled = False
    P3_CommandButtonCanc.Default = True
Else
    P3_CommandButtonOK.Enabled = True
    P3_CommandButtonOK.Default = True
End If

End Sub

Private Sub P3_TextBoxRelDocName1_Enter()

If P3_TextBoxRelDocName1 <> "Name" Then
    Exit Sub
Else
    P3_TextBoxRelDocName1.Value = ""
    P3_TextBoxRelDocName1.ForeColor = RGB(0, 0, 0)
End If

End Sub

Private Sub P3_TextBoxRelDocName1_Exit(ByVal Cancel As MSForms.ReturnBoolean)

If P3_TextBoxRelDocName1.Value <> "" And P3_TextBoxRelDocName1 <> "Name" Then
    Sheet3.Cells(RelDoc1Counter, 1) = P3_TextBoxRelDocName1
Exit Sub
Else
    P3_TextBoxRelDocName1.ForeColor = RGB(160, 160, 160)
    P3_TextBoxRelDocName1 = "Name"
End If

End Sub

Private Sub P3_TextBoxRelDocLink1_Enter()

If Not P3_TextBoxRelDocLink1 = "Link" Then
Exit Sub
Else

P3_TextBoxRelDocLink1.Value = ""
P3_TextBoxRelDocLink1.ForeColor = RGB(0, 0, 0)

End If

End Sub

Private Sub P3_TextBoxRelDocLink1_Exit(ByVal Cancel As MSForms.ReturnBoolean)

If P3_TextBoxRelDocLink1.Value <> "" And P3_TextBoxRelDocLink1 <> "Link" Then

Sheet3.Cells(RelDoc1Counter, 2) = P3_TextBoxRelDocLink1

Else
P3_TextBoxRelDocLink1.ForeColor = RGB(160, 160, 160)
P3_TextBoxRelDocLink1 = "Link"

End If

End Sub

Private Sub P3_TextBoxRelDocName2_Enter()

If P3_TextBoxRelDocName2 <> "Name" Then
    Exit Sub
Else
    P3_TextBoxRelDocName2.Value = ""
    P3_TextBoxRelDocName2.ForeColor = RGB(0, 0, 0)
End If

TabCheck = True

End Sub

Private Sub P3_TextBoxRelDocName2_Exit(ByVal Cancel As MSForms.ReturnBoolean)

If P3_TextBoxRelDocName2.Value <> "" And P3_TextBoxRelDocName2 <> "Name" Then
    Sheet3.Cells(RelDoc2Counter, 1) = P3_TextBoxRelDocName2
    Exit Sub
Else
    P3_TextBoxRelDocName2.ForeColor = RGB(160, 160, 160)
    P3_TextBoxRelDocName2 = "Name"
End If

End Sub

Private Sub P3_TextBoxRelDocLink2_Enter()

If P3_TextBoxRelDocLink2 <> "Link" Then
    Exit Sub
Else
    P3_TextBoxRelDocLink2.Value = ""
    P3_TextBoxRelDocLink2.ForeColor = RGB(0, 0, 0)
End If

End Sub

Private Sub P3_TextBoxRelDocLink2_Exit(ByVal Cancel As MSForms.ReturnBoolean)

If P3_TextBoxRelDocLink2.Value <> "" And P3_TextBoxRelDocLink2 <> "Link" Then
    Sheet3.Cells(RelDoc2Counter, 2) = P3_TextBoxRelDocLink2
    Call P3_FilledChecker
    Exit Sub
Else
    P3_TextBoxRelDocLink2.ForeColor = RGB(160, 160, 160)
    P3_TextBoxRelDocLink2 = "Link"
End If

End Sub

Private Sub P3_TextBoxRelDocLink2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

If TabCheck = False Then Exit Sub

If KeyCode = vbKeyTab And P3_TextBoxRelDocName2 <> "Name" Then
    P3_TextBoxRelDocName2.SetFocus
    SendKeys "{BS}", True
End If

End Sub

Private Sub P3_CommandButtonRelDocUp_Click()

P3_TextBoxRelDocName1 = Sheet3.Cells(RelDoc1Counter - 1, 1)
P3_TextBoxRelDocLink1 = Sheet3.Cells(RelDoc1Counter - 1, 2)
P3_TextBoxRelDocName2 = Sheet3.Cells(RelDoc2Counter - 1, 1)
P3_TextBoxRelDocLink2 = Sheet3.Cells(RelDoc2Counter - 1, 2)

RelDoc1Counter = RelDoc1Counter - 1
RelDoc2Counter = RelDoc2Counter - 1

If P3ComButUp = True Then
    P3_CommandButtonRelDocUp.Visible = True
Else
    P3_CommandButtonRelDocUp.Visible = False
End If

If P3ComButDown = True Then
    P3_CommandButtonRelDocDown.Visible = True
Else
    P3_CommandButtonRelDocDown.Visible = False
End If

If P3_TextBoxRelDocName1 = "" Or P3_TextBoxRelDocName1 = "Name" Then
    P3_TextBoxRelDocName1.ForeColor = RGB(160, 160, 160)
    P3_TextBoxRelDocName1 = "Name"
Else
    P3_TextBoxRelDocName1.ForeColor = RGB(0, 0, 0)
End If

If P3_TextBoxRelDocLink1 = "" Or P3_TextBoxRelDocLink1 = "Link" Then
    P3_TextBoxRelDocLink1.ForeColor = RGB(160, 160, 160)
    P3_TextBoxRelDocLink1 = "Link"
Else
    P3_TextBoxRelDocLink1.ForeColor = RGB(0, 0, 0)
End If

If P3_TextBoxRelDocName2 = "" Or P3_TextBoxRelDocName2 = "Name" Then
    P3_TextBoxRelDocName2.ForeColor = RGB(160, 160, 160)
    P3_TextBoxRelDocName2 = "Name"
Else
    P3_TextBoxRelDocName2.ForeColor = RGB(0, 0, 0)
End If

If P3_TextBoxRelDocLink2 = "" Or P3_TextBoxRelDocLink2 = "Link" Then
    P3_TextBoxRelDocLink2.ForeColor = RGB(160, 160, 160)
    P3_TextBoxRelDocLink2 = "Link"
Else
    P3_TextBoxRelDocLink2.ForeColor = RGB(0, 0, 0)
End If

End Sub

Private Sub P3_CommandButtonRelDocDown_Click()

P3_TextBoxRelDocName1 = Sheet3.Cells(RelDoc1Counter + 1, 1)
P3_TextBoxRelDocLink1 = Sheet3.Cells(RelDoc1Counter + 1, 2)
P3_TextBoxRelDocName2 = Sheet3.Cells(RelDoc2Counter + 1, 1)
P3_TextBoxRelDocLink2 = Sheet3.Cells(RelDoc2Counter + 1, 2)

RelDoc1Counter = RelDoc1Counter + 1
RelDoc2Counter = RelDoc2Counter + 1

If P3ComButUp = True Then
    P3_CommandButtonRelDocUp.Visible = True
Else
    P3_CommandButtonRelDocUp.Visible = False
End If

If P3ComButDown = True Then
    P3_CommandButtonRelDocDown.Visible = True
Else
    P3_CommandButtonRelDocDown.Visible = False
End If

If P3_TextBoxRelDocName1 = "" Or P3_TextBoxRelDocName1 = "Name" Then
    P3_TextBoxRelDocName1.ForeColor = RGB(160, 160, 160)
    P3_TextBoxRelDocName1 = "Name"
Else
    P3_TextBoxRelDocName1.ForeColor = RGB(0, 0, 0)
End If

If P3_TextBoxRelDocLink1 = "" Or P3_TextBoxRelDocLink1 = "Link" Then
    P3_TextBoxRelDocLink1.ForeColor = RGB(160, 160, 160)
    P3_TextBoxRelDocLink1 = "Link"
Else
    P3_TextBoxRelDocLink1.ForeColor = RGB(0, 0, 0)
End If

If P3_TextBoxRelDocName2 = "" Or P3_TextBoxRelDocName2 = "Name" Then
    P3_TextBoxRelDocName2.ForeColor = RGB(160, 160, 160)
    P3_TextBoxRelDocName2 = "Name"
Else
    P3_TextBoxRelDocName2.ForeColor = RGB(0, 0, 0)
End If

If P3_TextBoxRelDocLink2 = "" Or P3_TextBoxRelDocLink2 = "Link" Then
    P3_TextBoxRelDocLink2.ForeColor = RGB(160, 160, 160)
    P3_TextBoxRelDocLink2 = "Link"
Else
    P3_TextBoxRelDocLink2.ForeColor = RGB(0, 0, 0)
End If

End Sub


Private Sub P3_CommandButtonOK_Click()

LastRowA = LastRow(Sheet3, 1)

If Sheets(IDstr).Cells(1, 1) = "" Then
    LastRowOldA = 0
Else
    LastRowOldA = LastRow(Sheets(IDstr), 1)
End If

TitleArr = Sheet3.Range("A1:A1000")
LinkArr = Sheet3.Range("B1:B1000")

rngA = "A" & LastRowOldA + 1 & ":A1000"
rngB = "B" & LastRowOldA + 1 & ":B1000"

Sheets(IDstr).Range(rngA) = TitleArr
Sheets(IDstr).Range(rngB) = LinkArr

LastRowNewA = LastRow(Sheets(IDstr), 1)
LastRowNewB = LastRow(Sheets(IDstr), 2)

Sheet3.Range("A:B") = ""

If LastRowNewA = 1 And Sheets(IDstr).Cells(1, 1) = "" Then
    Sheet1.Cells(TargetRow, 10) = 0
Else
    Sheet1.Cells(TargetRow, 10) = LastRowNewA
End If

Call AcceptID

End Sub

Private Function P3_OkEnable()

If P3_TextBoxRelDocName1 = "" And P3_TextBoxRelDocLink1 = "" Then
P3_OkEnable = False
Else
P3_OkEnable = True
End If

End Function




'Page 4


Private Sub P4_CommandButtonCanc_Click()

Me.Hide

End Sub

Private Sub P4_TextBoxCom_Change()

If EnableEvents = False Then Exit Sub

Call P4_OkEnable

End Sub

Private Sub P4_OkEnable()

If Not P4_TextBoxCom = "" Then
    P4_CommandButtonOK.Enabled = True
    P4_CommandButtonOK.Default = True
Else
    P4_CommandButtonOK.Enabled = False
    P4_CommandButtonCanc.Default = True
End If

End Sub

Private Sub P4_CommandButtonOK_Click()

Call P4_OK

Call AcceptID

End Sub




'Page 5



Private Sub P5_CheckBoxComp_Click()

Call p5_OKEnable

End Sub

Private Sub P5_CommandButtonCanc_Click()

Me.Hide

End Sub




Private Sub P5_CommandButtonOK_Click()

If P5_CheckBoxComp = False Then
    Call Uncomplete
Else
    Call Complete
End If

Me.Hide

End Sub

Private Sub p5_OKEnable()

If (Sheet1.Cells(TargetRow, 8) = 0 And P5_CheckBoxComp = False) Or (Sheet1.Cells(TargetRow, 8) = 1 And P5_CheckBoxComp = True) Then
    P5_CommandButtonOK.Enabled = False
Else
    P5_CommandButtonOK.Enabled = True
End If

End Sub

Private Sub TextBoxDesc_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ' If right-button clicked
    If Button = 2 Then
        Call ShowPopup(Me, TextBoxDesc.Text, X, Y, TextBoxDesc)
    End If
End Sub

Private Sub UserForm_Activate()

RDMID = False
CMID = False

Sheet1.Activate

If OpButSel = True Then

    Call LoadIDs
    Call AcceptID

    RelDoc1Counter = 1
    RelDoc2Counter = 2

    With Me.MultiPage1
        .Pages(0).Visible = False
        .Pages(1).Visible = True
        .Pages(2).Visible = True
        .Pages(3).Visible = True
        .Pages(4).Visible = True
        If Manager = True Then .Pages(5).Visible = True
    End With

    If Comp = True Then Me.MultiPage1.Value = 4
    If CMActivate = True Then Me.MultiPage1.Value = 3
    If RelDocSelect = True Then Me.MultiPage1.Value = 2

    Comp = False
    CMActivate = False
    RelDocSelect = False

Else

    With Me.MultiPage1
        .Pages(0).Visible = True
        .Pages(1).Visible = False
        .Pages(2).Visible = False
        .Pages(3).Visible = False
        .Pages(4).Visible = False
        .Pages(5).Visible = False
    End With

    RDMID = False
    CMID = False

End If

End Sub

Private Sub MultiPage1_Click(ByVal Index As Long)

Select Case MultiPage1.SelectedItem.Name
    Case "Page1": Call P1Switch
    Case "Page2": Call P2Switch
    Case "Page3": Call P3Switch
    Case "Page4": Call P4Switch
    Case "Page5": Call P5Switch
    Case "Page6": Call P6Switch
End Select

End Sub

Private Sub P1Switch()



End Sub

Private Sub P2Switch()

EditTasks.Height = 280

End Sub

Private Sub P3Switch()

EditTasks.Height = 240

End Sub

Private Sub P4Switch()

EditTasks.Height = 240

End Sub

Private Sub P5Switch()

EditTasks.Height = 240

End Sub

Private Sub P6Switch()

EditTasks.Height = 280

End Sub



Private Sub UserForm_Initialize()

    With EditTasks
        .Top = Application.Top + 125
        .Left = Application.Left + 25
    End With

    Call UpdateOwn

End Sub

Private Sub UserForm_Terminate()

Call HideNewTask

End Sub

提前致谢...

excel-vba vba excel
1个回答
0
投票

在我休息期间遇到了我的一位朋友,他提供了答案:

在属性窗口中将按钮设置为“取消=真”将导致此问题,并且对于用户窗体上的所有按钮将此属性重置为False会消除此问题

© www.soinside.com 2019 - 2024. All rights reserved.