زر إلغاء userform _intermitty_ غير مستجيب؟

Question

إجراءات VBA المرفقة مخصصة لمستخدم شريط التقدم. كل شيء يعمل كما هو متوقع ، إلا أن زر الإلغاء هو بشكل متقطع غير مستجيب.

أقول بشكل متقطع لأنه ، 95 ٪ من الوقت يجب علي النقر فوق الزر "إلغاء" عدة مرات قبل توقف الإجراء. أستطيع أن أرى أن حدث النقر فوق الزر يتم تحريكه ، لكن الإجراء لم ينقطع. يبدو أن هناك شيئًا ما يسرق التركيز من زر إلغاء قبل أن يحدث الحدث لأسفل.

تستجيب أزرار الهروب والإغلاق كما هو متوقع بنقرة واحدة.

ما الذي يجب علي فعله لجعل زر الإلغاء يستجيب بشكل صحيح؟ شكرًا!

تحديث: لقد لاحظت أنه عند النقر فوق الزر "إلغاء" وأمسكه على زر "إلغاء" ، بدلاً من الزر الذي يبقى "لأسفل" ، يتم إعادة تشغيله. لذلك يبدو أن هناك شيئًا ما يعيد تعيين حالة الزر إلى أعلى ، بسرعة كافية بحيث لا يصطاد الإجراء الحالة لأسفل لإطلاق حدث النقر.

فيما يلي الرمز الموجود في وحدة Userform (اسمه userform1):

Private mbooUserCancel As Boolean

Public Property Get UserCancel() As Boolean
    UserCancel = mbooUserCancel
End Property

Private Property Let UserCancel(ByVal booUserCancel As Boolean)
    mbooUserCancel = booUserCancel
End Property

Public Sub UpdateProgress(CountTotal As Long, CountProgress As Long)
    On Error GoTo Error_Handler
    ProgressBar1.Value = CountProgress / CountTotal * 100
    DoEvents
Error_Handler:
    If Err.Number = 18 Then CommandButton1_Click
End Sub

Private Sub CommandButton1_Click()
    Hide
    UserCancel = True
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Cancel = True
    CommandButton1_Click
End Sub

Private Sub UserForm_Activate()
    With Application
        .Interactive = False
        .EnableCancelKey = xlErrorHandler
    End With
End Sub

Private Sub UserForm_Terminate()
    Application.Interactive = True
End Sub

فيما يلي رمز الوحدة النمطية (المسماة الوحدة 1) التي تستدعي userform1:

Sub TestProgress()

    On Error GoTo Error_Handler

    Dim objUserForm As New UserForm1
    Dim lngCounter As Long
    Dim lngSubCounter As Long

    With objUserForm
        .Show vbModeless
        DoEvents
        For lngCounter = 1 To 5
            If .UserCancel Then GoTo Exit_Sub
            For lngSubCounter = 1 To 100000000
            Next lngSubCounter
            .UpdateProgress 5, lngCounter
        Next lngCounter
        Application.Wait Now + TimeValue("0:00:02")
        .Hide
    End With

Exit_Sub:

    If objUserForm.UserCancel Then
        MsgBox "User Cancelled from UserForm1"
    End If
    Exit Sub

Error_Handler:

    If Err.Number = 18 Then
        Unload objUserForm
        MsgBox "User Cancelled from Module1"
    End If

End Sub

Answer 1

الجواب هو استخدام Userforms Modal لأشرطة التقدم بحيث يمكن لحدث النقر فوق الزر إطلاق النار دون أن يحجبها المعالجة في إجراء الاتصال.

Answer 2

يعمل بالنسبة لي على النقر الأول في كل مرة. حاول تفريغ أي إضافات أو أي رمز آخر يمكن تشغيله داخل تطبيق الحاوية ومعرفة ما إذا كان ذلك يساعد.

Answer 3

إذا كان الناس لا يزالون في حاجة إلى الإجابة ، فقد بحثت وتصدعها!

للحصول على زر Click On Cancel ، يجب أن يكون الرمز ؛

Private Sub CommandButton1_Click()

Unload Me

'this bit ends all macros

End

End Sub