单位可以参照修改使用，好用的电话簿

期待_2012_い

学习学习。。。谢谢 分享

ζ_ＴＴ

好东西先顶了先~

baobao0001

学习了，谢谢！

wkxxxr

做得好极了，界面清晰，收藏了！

wkxxxr

表1里部门名称应该怎样修改呢？

grf1973

建议：
1、数据表输入好后，运行一下“初始化”，把相应的部门作为各按钮的Caption
2、多余按钮隐藏掉，需显示的按钮重新排列
3、各按钮的代码可以统一：t=CommandButton**.Caption
4、是否可以用类模块实现控件数组。

1. Sub 初始化()
   
2.     arr = Sheet2.[a1].CurrentRegion
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     For i = 2 To UBound(arr)
   
5.         d(arr(i, 6)) = ""
   
6.     Next
   
7.     dk = d.keys    '各部门去重
   
8.     With Sheet1
   
9.         For i = 0 To UBound(dk)
   
10.         .OLEObjects("CommandButton" & i + 4).Object.Caption = dk(i)   '各按钮内容为各部门
    
11.         Next
    
12.     End With
    
13. End Sub
    

复制代码

wkxxxr

grf1973 发表于 2013-12-18 16:41
建议：
1、数据表输入好后，运行一下“初始化”，把相应的部门作为各按钮的Caption
2、多余按钮隐藏掉，需 ...

好像运行出现错误？

grf1973

wkxxxr 发表于 2013-12-18 21:18
好像运行出现错误？

我用自己单位试过,十来个部门，没问题。

wkxxxr

grf1973 发表于 2013-12-18 22:15
我用自己单位试过,十来个部门，没问题。

可否传附件，谢谢！

grf1973

把多余的也隐藏了，不过如何排序没好好考虑，也就是用个top和left确定每个按钮的位置而已。
在workbook_open事件里运行下面代码就行了。

1. Sub 初始化()
   
2.     Dim obj As OLEObject
   
3.     arr = Sheet2.[a1].CurrentRegion
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     For i = 2 To UBound(arr) '各部门去重
   
6.         d(arr(i, 6)) = ""
   
7.     Next
   
8.     dk = d.keys
   
9.     With Sheet1
   
10.         For i = 0 To UBound(dk)
    
11.             .OLEObjects("CommandButton" & i + 4).Object.Caption = dk(i)   '各按钮内容为各部门
    
12.         Next
    
13.    
    
14.         For Each obj In .OLEObjects
    
15.             If obj.progID = "Forms.CommandButton.1" Then
    
16.                 n = n + 1
    
17.                 If n > d.Count Then obj.Visible = False   '隐藏多余按钮
    
18.                 If n > 50 Then obj.Visible = True   '显示“数据库”按钮
    
19.             End If
    
20.         Next
    
21.     End With
    
22.     End Sub
    
23. 
    

复制代码