按键盘上方向键 ← 或 → 可快速上下翻页，按键盘上的 Enter 键可回到本书目录页，按键盘上方向键 ↑ 可回到本页顶部！
————未阅读完？加入书签已便下次继续阅读！
Else
ColumnLetter = Chr（ColumnNumber ＋ 64）
End If
End Function
435
…………………………………………………………Page 436……………………………………………………………
EXCEL 能否按照单元格内文字的颜色排序
EXCEL 能否按照单元格内文字的颜色排序，或把相同颜色的行集中到一起显示。
解答：方法一，1。以VBA 判斷 colorindex，加輔助欄實現；2。不以程式輔助要實現………》
不可能。
方法二，不用 VBA 也可以的；可用 get。cell（24） EXCEL 宏函数定义名称；辅助列还是需
要的。
怎么能让一个加载宏监控所有打开的 excel 文件
我们可以在 thisworkbook_open 或 sheet1_activate 中加入自己的代码从而监视本文件中的各
个事件，执行指定的代码。但如果你编写的是一个加载宏，你所要监视的文件就不单单是当
前的文件了，而是所有打开的文件。但加载宏在后台运行时，用户可能会新打开或关闭文件
等执行各种操作，从而可能会出现错误。
为了实现加载宏在后台对所有操作进行监控，我把 Excel 帮助翻个底朝天，终于实现了这种效
果。这几天看到有些朋友也存在这中问题，将自己的一点心得拿出来与大家分享。
要实现这种效果，首先要定义一个 Application 类
在 VBA 项目中添加一个类模块 AppEventCls ，进行声明：
Public WithEvents App As Application
这时在代码编辑窗口上面的对象下拉框中就多出了一个新的对象“App” ，选中“App” ，右边的事
件下拉框中可以看到对应的事件“NewWorkbook” ，“SheetActivate”等，哈！这就是我们所要的！
选中“NewWorkbook” ，在代码编辑窗口中出现：
Private Sub App_NewWorkbook（ByVal Wb As Workbook）
End Sub
添加代码：
MsgBox 〃Hey！ You opened a new workbook！〃
现在可以执行了吗？噢，还要等一下，我们必须先定义一个属于这个类的对象。
在项目中添加一个新的模块
添加对象的定义
Dim MyApp As New AppEventCls
在自动运行过程中指定对象
Public Sub Auto_Open（）
Set MyApp。App = Application
End Sub
将文件存为加载宏，如“ControlApp。xla” ，然后就可以欣赏自己的成果了！
关闭此文件，然后加载刚保存的加载宏。打开一个文件试试。
在类模块中的其他事件中加入代码试试，可以看到这个加载宏响应所有文件的事件！
把公式排整齐
公式太长，尤其当使用了许多函数，括号一层迭一层时，公式便会变得难以理解。你可以在适
当位置按＜Alt ＞＋ ＜Enter ＞来插入分列符号，甚至加进空格，把公式排得整整齐齐。
寻找特定档案并以对应的软件开启
可否在 excel 中输入一个 档名，excel 会到预定 path 下的 folder 找出该案并开启呢？
436
…………………………………………………………Page 437……………………………………………………………
解答 1：如果知道具体位置，可这样：
Sub Find_WorkBook（）
Dim wb As Workbook
Dim String1； String2； Message； Title； Default As String
Default = 〃WindRider〃
Title = 〃Find WorkBook〃
String1 = InputBox（Message； Title； Default）
String2 = Application。ActiveWorkbook。Path
Set wb = Workbooks。Open（String2 & 〃” & String1 & 〃。xls〃； False； False）
End Sub
解答 2：如果只知道文档会在某个 path 下，但实际位置要 search，可这样：
Sub Find_WorkBook（）
On Error Resume Next
Dim wb As Workbook
Dim String1； String2； Message； Title； Default As String
Default = 〃OnKey〃
Title = 〃Find WorkBook〃
String1 = InputBox（Message； Title； Default）
If String1 = 〃〃 Then
Exit Sub
End If
With Application。FileSearch
。NewSearch
。LookIn = 〃E：Autos〃
。MatchTextExactly = True
。FileType = msoFileTypeExcelWorkbooks
。SearchSubFolders = True
。Filename = Trim（String1） & 〃。xls〃
If 。Execute（） 》 0 Then
String2 = 。FoundFiles（1）
Set wb = Workbooks。Open（String2； False； False）
Else
MsgBox （〃File No Found！〃）
Exit Sub
End If
End With
End Sub
（'Default = 〃OnKey〃 是设定输入对话方块的预设值。'FoundFiles（1）可能发现很多个相同名称
的文件，但我要打开的是第一个发现的文件。'改成 FileType = msoFileTypeAllFiles。）
又问：如何根据找到的档案以相关的程式开启呢？
答：ActiveWorkbook。FollowHyperlink 。FoundFiles（1）
437
…………………………………………………………Page 438……………………………………………………………
如何将文件中的某一类控件全部删除
我的文件中有各种各样的控件，我希望将所有工作表中某一类控件（如 mandbutton，包
括隐藏的控件）全部删除，程序怎么编？
解答：Sub Dtlshtbtn（）
For Each sht In ActiveWorkbook。Sheets
For Each BtnObj In sht。OLEObjects
If Left（BtnObj。Name； 13） = 〃mandButton〃 Then
BtnObj。Delete
End If
Next BtnObj
Next sht
End Sub
又问：我的控件的 name 已改过（初期设计时未注意规范），不能保证前几位是相同的，有什
么办法判断？
解答：改一下即可
Sub Dtlshtbtn（）
For Each sht In ActiveWorkbook。Sheets
For Each btnobj In sht。OLEObjects
If Left（btnobj。ProgId； 19） = 〃Forms。mandButton〃 Then
btnobj。Delete
End If
Next btnobj
Next sht
End Sub
如何列出工具栏快显菜单和单元格右键菜单
1、 列出工作表标签按右键出现的〃快显功能表〃
2、 Sub test（）
3、 k = Application。mandBars（〃Ply〃）。Controls。Count
4、 For i = 1 To k
5、 MsgBox 〃Id：〃 & i & Chr（13） &
Application。mandBars（〃Ply〃）。Controls（i）。Caption
6、 Next i
7、 End Sub
8、 列出工具栏快显菜单
9、 Sub ListShortCutMenus（）
10、 Cells。Clear
11、 Application。ScreenUpdating = False
12、 Row = 1
13、 For Each cbar In mandBars
14、 If cbar。Type = msoBarTypePopup Then
15、 Cells（Row； 1） = cbar。Index
438
…………………………………………………………Page 439……………………………………………………………
16、 Cells（Row； 2） = cbar。Name
17、 For col = 1 To cbar。Controls。Count
18、 Cells（Row； col ＋ 2） = _
19、 cbar。Controls（col）。Caption
20、 Next col
21、 Row = Row ＋ 1
22、 End If
23、 Next cbar
24、 Cells。EntireColumn。AutoFit
25、 End Sub
26 、
27、 列出单元格右键菜单
28、 Sub ListCellControls（）
29、 k = Application。mandBars（〃Cell〃）。Controls。Count
30、 For i = 1 To k
31、 Cells（i； 1） = i 'ID
32、 Cells（i； 2） = Application。mandBars（〃Cell〃）。Controls（i）。Caption
33、 Next i
34、 End Sub
如何删除目录及文件
设 D：ab下有 a。。。。。z 等 5 个以上的子目录，目录下有文件，我想保留最后建立的 5 个子目录，
其余的全部删除，。请各位帮忙，谢谢！
解答：Dim MyPath； MyName As String
Dim I； J As Integer
Dim Fs As Object
Dim F
MyPath = 〃D：ab”
MyName = Dir（MyPath； vbDirectory）
Set Fs = CreateObject（〃Scripting。FileSystemObject〃）
Sheets（1）。Cells（1； 1）。CurrentRegion。Clear
I = 1
Do While MyName 〃〃
If MyName 〃。〃 And MyName 〃。。〃 Then