关于findcontrol的疑问

dogingate

本来是想重新写一个多级联动菜单的代码的，想到用findctrol的办法，但是明明之前创建过这个ctrl，在下一次循环后就没有找到，不知道咋回事情
看来还是只能用字典判断唯一性啊

Sub menuListLoading()

Dim cbarName
Dim menuName
Dim menuCaption
Dim oldCtrl
Dim newCtrl
Dim preCtrl
Dim preMenuName
Dim str

cbarName = "qlbh"
Application.CommandBars(cbarName).Delete
Set cbar = Application.CommandBars.Add(Name:=cbarName, Position:=msoBarPopup, Temporary:=False)

Set sht = Worksheets("菜单列表")
Set rng = sht.Range("a1").CurrentRegion

For i = 1 To rng.Rows.Count
    For j = 1 To rng.Columns.Count
        If sht.Cells(i, j) = "" Then
            Exit For
        End If

        If j = 1 Then
            menuName = sht.Cells(i, j)
            menuCaption = menuName
            Set oldCtrl = cbar.FindControl(Type:=msoControlPopup, Tag:=menuName)
            If oldCtrl Is Nothing Then
                Set preCtrl = cbar
                If sht.Cells(i, j + 1) <> "" Then
                    Set newCtrl = preCtrl.Controls.Add(Type:=msoControlPopup)
                Else
                    Set newCtrl = preCtrl.Controls.Add(Type:=msoControlButton)
                    newCtrl.OnAction = "'WriteToRng " & i & "'"
                End If
                With newCtrl
                    .Caption = menuCaption
                    .Tag = menuName
                End With
            End If
        Else
            preMenuName = sht.Cells(i, j - 1)
            menuName = sht.Cells(i, j)
            str = Split(menuName, " ")
            menuCaption = str(UBound(str))
            Set oldCtrl = cbar.FindControl(Type:=msoControlPopup, Tag:=menuName)
            If oldCtrl Is Nothing Then
                Set preCtrl = cbar.FindControl(Type:=msoControlPopup, Tag:=preMenuName)
                If sht.Cells(i, j + 1) <> "" Then
                    Set newCtrl = preCtrl.Controls.Add(Type:=msoControlPopup)
                Else
                    Set newCtrl = preCtrl.Controls.Add(Type:=msoControlButton)
                    newCtrl.OnAction = "'WriteToRng " & i & "'"
                End If
                With newCtrl
                    .Caption = menuCaption
                    .Tag = menuName
                End With
            End If
        End If

    Next j
Next i

cbar.ShowPopup

End Sub

dogingate

所以我只能用字典了，但是加载项多了，还是有点慢

Sub menuListLoading3()

Dim cbarName
Dim menuName
Dim menuCaption
Dim oldCtrl
Dim newCtrl
Dim preCtrl
Dim preMenuName
Dim str

cbarName = "qlbh"
Application.CommandBars(cbarName).Delete
Set cbar = Application.CommandBars.Add(Name:=cbarName, Position:=msoBarPopup, Temporary:=False)

Set sht = Worksheets("菜单列表")
Set rng = sht.Range("a1").CurrentRegion

Set zd = CreateObject("scripting.dictionary")

For i = 1 To rng.Rows.Count
    For j = 1 To rng.Columns.Count
        
        If sht.Cells(i, j) = "" Then
            Exit For
        End If
        
        If j = 1 Then
            menuName = sht.Cells(i, j)
            menuCaption = menuName
            If Not zd.exists(menuName) Then
                Set preCtrl = cbar
                If sht.Cells(i, j + 1) <> "" Then
                    Set newCtrl = preCtrl.Controls.Add(Type:=msoControlPopup)
                Else
                    Set newCtrl = preCtrl.Controls.Add(Type:=msoControlButton)
                    newCtrl.OnAction = "'WriteToRng " & i & "'"
                End If
                With newCtrl
                    .Caption = menuCaption
                    .Tag = menuName
                End With
                zd.Add menuName, newCtrl
            End If
        Else
            preMenuName = sht.Cells(i, j - 1)
            menuName = sht.Cells(i, j)
            str = Split(menuName, " ")
            menuCaption = str(UBound(str))
            If Not zd.exists(menuName) Then
                Set preCtrl = zd(preMenuName)
                If sht.Cells(i, j + 1) <> "" Then
                    Set newCtrl = preCtrl.Controls.Add(Type:=msoControlPopup)
                Else
                    Set newCtrl = preCtrl.Controls.Add(Type:=msoControlButton)
                    newCtrl.OnAction = "'WriteToRng " & i & "'"
                End If
                With newCtrl
                    .Caption = menuCaption
                    .Tag = menuName
                End With
                zd.Add menuName, newCtrl
            End If
        End If
        
    Next j
Next i

cbar.ShowPopup

End Sub