VBA Excel тег кнопки меню и свойство заголовка - PullRequest
Новая
       82

VBA Excel тег кнопки меню и свойство заголовка

0 голосов
/ 04 августа 2020

У меня проблема с настраиваемой строкой меню. Чтобы создать строку меню, я использовал 2 класса (которые ссылаются друг на друга - я скопировал и изменил из источников inte rnet ...), как показано ниже: 

'clsCreateMenu class module:

Option Explicit
Private myObj() As clsButton
Private Sub Class_Initialize()
Dim i As Double, cb As CommandBar, cpop As CommandBarPopup
Set cb = Application.CommandBars("Worksheet Menu Bar")
With cb
    .Enabled = True
    .Visible = True
    .Reset
End With
Set cpop = cb.Controls.Add(msoControlPopup, , , , True)
cpop.caption = "MyMenu"
ReDim myObj(1 To 3) As clsButton
For i = LBound(myObj) To UBound(myObj)
    Set myObj(i) = New clsButton
    With myObj(i)
        .addNew cpop
        .caption = "Cap" & i
        .tag = "tag" & i
        Set .Callback = Me
    End With
Next i
End Sub
Sub TriggerAnEvent(IDer As String)
Select Case IDer
    Case "tag1"
        MsgBox "1 clicked"
    Case "tag2"
        MsgBox "2 clicked"
    Case "tag3"
        MsgBox "3 clicked"
End Select
End Sub
Private Sub Class_Terminate()
    Set myObj() = Nothing
End Sub

' clsButton class module:

Option Explicit
Private mCallback As clsCreateMenu
Public WithEvents mBttn As CommandBarButton
Sub addNew(rhs As Object)
Set mBttn = rhs.Controls.Add(msoControlButton, , , , True)
    mBttn.Style = msoButtonCaption
End Sub
Property Let caption(rhs As String)
    mBttn.caption = rhs
End Property
Property Let tag(rhs As String)
    mBttn.tag = rhs
End Property
Property Set Callback(newObj As clsCreateMenu)
    Set mCallback = newObj
End Property
Private Sub mBttn_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
    mCallback.TriggerAnEvent mBttn.tag
End Sub
Private Sub Class_Terminate()
    Set mCallback = Nothing
    Set mBttn = Nothing
End Sub

' Main module:

Option Explicit
Private makeMenu As clsCreateMenu
Sub disMenu()
    Application.CommandBars("Worksheet Menu Bar").Reset
End Sub
Sub createMenu()
    Set makeMenu = New clsCreateMenu
End Sub

проблема: для первого когда я запускаю sub createMenu, все в порядке ie. Но затем я запускаю sub disMenu и запускаю createMenu, появляется сообщение об ошибке. Я обнаружил, что каждый раз, когда я запускаю createMenu, vba создает один новый экземпляр clsButton. Итак, со второго запуска двух вышеупомянутых подпрограмм было создано несколько экземпляров clsButton. НО ... если я изменю IDer с ".tag" на ".caption", проблема исчезнет, ​​он будет работать без сбоев независимо от того, сколько раз я запускал sub disMenu, а затем sub createMenu снова и снова ...

Я не знаю, почему такая проблема возникает в моем случае ... так что, пожалуйста, кто-нибудь может помочь мне определить root этой проблемы? и как я могу обнаружить любой существующий экземпляр определенного класса, а затем удалить (закрыть) этот экземпляр перед созданием нового? (я пытаюсь установить var на ничего, но похоже, что это не работает ...)

Большое спасибо за вашу помощь ... Triet (mr)

...