[已解决]自定义工具栏提取按钮名称和宏

xdwy81129

问题请教如下：

该工作薄内含自己自定义的工具栏——“学习”
现在希望可以把工具栏里面的按钮，全部放在当前的工作表内
实现的目的即
1.在当前工作表内新建多个控件按钮，如旁边的按钮
2.提取自定义工具栏“学习”里面的按钮的名称，及该按钮指向的宏过程
3.为上面1新建的按钮变更名称在2提取的名称，并指向改名称指定的宏
操作好像很复杂，不知道可不可以实现。
谢谢大虾了。

如果可以分步骤，关键是第2步最难，剩下的自己语句要简单些

工具栏转.rar (8.1 KB, 下载次数: 25)

2011-4-24 16:16 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

unsamesky

2011-4-24 16:18

1. Sub test()
   
2.   Dim pop As CommandBarPopup
   
3.   Dim cmb As CommandBarButton
   
4.   Dim mc As CommandBarControl
   
5.   Dim mb As Shape, n As Long, rng As Range
   
6. 
   
7.   For Each mc In CommandBars("学习").Controls
   
8.       Select Case TypeName(mc)
   
9.       Case "CommandBarPopup"
   
10.            For Each cmb In mc.Controls
    
11.                GoSub SettingControls
    
12.            Next
    
13.       Case "CommandBarButton":
    
14.            Set cmb = mc
    
15.            GoSub SettingControls
    
16. 
    
17.       End Select
    
18.   Next
    
19. 
    
20. Exit Sub
    
21. SettingControls:
    
22.   n = n + 1
    
23.   Set rng = Cells(n * 2, "H")
    
24.   Dim mk As Shape
    
25.   For Each mk In Sheet3.Shapes
    
26.       If mk.TextFrame.Characters.Text = cmb.Caption Then mk.Delete
    
27.   Next
    
28.   Set mb = Sheet3.Shapes.AddFormControl(xlButtonControl, Left:=rng.Left, Top:=rng.Top, Width:=50, Height:=30)
    
29.       mb.TextFrame.Characters.Text = cmb.Caption
    
30.       mb.OnAction = cmb.OnAction
    
31.   Return
    
32. End Sub
    
33. 
    

复制代码

详见附件！

跳转到最佳答案楼层

unsamesky

1. Sub test()
   
2.   Dim pop As CommandBarPopup
   
3.   Dim cmb As CommandBarButton
   
4.   Dim mc As CommandBarControl
   
5.   Dim mb As Shape, n As Long, rng As Range
   
6. 
   
7.   For Each mc In CommandBars("学习").Controls
   
8.       Select Case TypeName(mc)
   
9.       Case "CommandBarPopup"
   
10.            For Each cmb In mc.Controls
    
11.                GoSub SettingControls
    
12.            Next
    
13.       Case "CommandBarButton":
    
14.            Set cmb = mc
    
15.            GoSub SettingControls
    
16. 
    
17.       End Select
    
18.   Next
    
19. 
    
20. Exit Sub
    
21. SettingControls:
    
22.   n = n + 1
    
23.   Set rng = Cells(n * 2, "H")
    
24.   Dim mk As Shape
    
25.   For Each mk In Sheet3.Shapes
    
26.       If mk.TextFrame.Characters.Text = cmb.Caption Then mk.Delete
    
27.   Next
    
28.   Set mb = Sheet3.Shapes.AddFormControl(xlButtonControl, Left:=rng.Left, Top:=rng.Top, Width:=50, Height:=30)
    
29.       mb.TextFrame.Characters.Text = cmb.Caption
    
30.       mb.OnAction = cmb.OnAction
    
31.   Return
    
32. End Sub
    
33. 
    

复制代码

详见附件！

kongtong3

这个例子很特别，收藏备用