按键盘上方向键 ← 或 → 可快速上下翻页，按键盘上的 Enter 键可回到本书目录页，按键盘上方向键 ↑ 可回到本页顶部！
————未阅读完？加入书签已便下次继续阅读！
ElseIf Target。Value = 〃d〃 Then
Target。Value = 0
End If
End Sub
或者：如果临时要用，在“工具－自动更正”里设置也可以。
打开一张工作表时系统提示要求输入用户名和密码
解答：
If Application。InputBox（〃请输入密码：〃） = 〃〃 Then
Sheets（〃。。。。。〃）。Visible = True
Sheets（〃。。。。。〃）。Select
Range（〃。。。〃）。Select
Else： c = 〃对不起，密码不正确〃
d = 〃 警告〃
MsgBox prompt：=c； Title：=d
End
End If
工具菜单与视图中的工具栏不同
屏蔽工具菜单宏
sub notool（）
MenuBars（xlWorksheet）。Menus（〃工具〃）。Delete
end sub
解除屏蔽
sub yestool（）
MenuBars（xlWorksheet）。reset
end sub
Alt＋F11 进入 VBA 编辑
插入模块
将上面宏复制到模块
运行宏。OK
415
…………………………………………………………Page 416……………………………………………………………
限制使用某张工作表
解答：只有在 A1 单元格内输入 12345 时，其它单元格才能输入数据。
Private Sub Worksheet_Change（ByVal Target As Range）
ActiveSheet。Unprotect 〃123〃
Range（〃A1〃）。Locked = False
ActiveSheet。Protect 〃123〃
If Target。Address = 〃A1〃 Then
If Cells（1； 1）。Value = 12345 Then ActiveSheet。Unprotect 〃123〃
Else
If Cells（1； 1）。Value = 12345 Then ActiveSheet。Unprotect 〃123〃
End If
End Sub
怎样建立没有右边箭头的子菜
答：我用这样的语句建立菜单，没有子菜单。是 Wswx 教的
Dim Menu As mandBarControl； SubMenu As mandBarControl
Set Menu = Application。mandBars（1）。Controls。Add（msoControlPopup； ； ； ； True）
With Menu
。Caption = 〃工作菜单（&G）〃
End With
With Menu。Controls。Add（msoControlButton； 1； ； ； True）
。Caption = 〃输入资料 （&I）〃
。OnAction = 〃showform〃
End With
With Menu。Controls。Add（msoControlButton； 1； ； ； True）
。Caption = 〃查阅资料 （&C）〃
。OnAction = 〃pickup〃
End With
请教如何准确取值
a1 格 东：ww34…99 生产 ，a2 格 西：123…fd…12 设计开发 ，a3 格 南：88…77 负责销售
以上是三个单元格的内容，现在我想将产品代码单独取出放到b1；b2；b3 中，不知如何处理（用
vba ），请指点，谢谢！规律是冒号以后，文字以前的，如上面的 ww34…99；123…fd…12；88…77；如
何将他们分别取出？
解答：1 以 A1：A10 为例：
Sub test（）
Dim rng As Range
Dim tmp As Integer
For Each rng In Range（〃A1：A10〃）
tmp = InStr（1； rng。Text； 〃：〃）
rng。Offset（0； 1） = IIf（tmp 》 0； Mid（rng。Text； tmp ＋ 1）； 〃〃）
Next
416
…………………………………………………………Page 417……………………………………………………………
End Sub
解答 2 ：Sub test（）
Dim i As Integer
Dim tmp As Integer
Dim i As Range
For Each rng In Range（〃A1：A10〃）
If rng = 〃〃 Then Exit Sub
tmp = InStr（1； rng。Text； 〃：〃）
For i = （tmp ＋ 1） To Len（rng）
If Asc（Mid（rng； i； 1）） 》 0 And Asc（Mid（rng； i； 1）） 《 132 Then
rng。Offset（0； 1） = rng。Offset（0； 1） & Mid（rng； i； 1）
End If
Next
Next
End Sub
（注：正确应该是 122，只不过中文字不会小于 132 故也没出错。字符如下：
0～9 48～57
小写 a～z 97～122
大写 A～Z 65～90
例： ASC（A）=65）
如何在单元格中显示文件创建的日期
答：下例显示 C： 中部分文件的创建日期； 涉及文件属性及其它； 请参阅 FileSystemObject
对象
Sub ShowFileList（）
Dim fs； f； f1； fc； folderspec
folderspec = 〃C：”
Set fs = CreateObject（〃s cripting。FileSystemObject〃）
Set f = fs。GetFolder（folderspec）
Set fc = f。Files
For Each f1 In fc
Debug。Print f1。Name； f1。DateCreated
Next
End Sub
根据系统时间判断是否执行某宏
解答：本范例设定 my_Procedure 这个宏在下午 5 点开始执行。
Application。OnTime TimeValue（〃17：00：00〃）； 〃my_Procedure〃
见 ontime 之 help 范例
解答 2：本示例设置 15 秒后运行 my_Procedure 过程，从现在开始计时。
Application。OnTime Now ＋ TimeValue（〃00：00：15〃）； 〃my_Procedure〃
417
…………………………………………………………Page 418……………………………………………………………
删除当前活动工作簿
Sub 删除当前工作簿（）
'
Dim x； y； z
x = ActiveWorkbook。FullName
z = ActiveWorkbook。Path
If z = 〃〃 Then
y = MsgBox（〃确实彻底删除当前工作簿吗？〃； vbYesNo）
If y = vbNo Then Exit Sub
If y = vbYes Then ActiveWorkbook。Close savechanges：=False
End If
If z 〃〃 Then
y = MsgBox（〃确实彻底删除当前工作簿吗？〃； vbYesNo）
If y = vbNo Then Exit Sub
If y = vbYes Then
ActiveWorkbook。Close savechanges：=False
Kill x
End If
End If
End Sub
如何以工作簿中的一个 SHEET 是否激活为判断条件
解答 1：If ActiveSheet。Name = 〃Operation〃 Then
MsgBox 〃It's Ok〃
Else
MsgBox 〃It's fault〃
End If
解答 2 ：分别建：
Private Sub Worksheet_Activate（）
MsgBox 〃It's Ok〃
End Sub
Private Sub Worksheet_Deactivate（）
MsgBox 〃It's fault〃
End Sub
教各位关于按钮位置的问题
本人设计了一个按钮，设计在 A12 上，现在我要在 A13 上加上数据后，如何让按钮的位置自
动下移下一行？
解答：Private Sub Worksheet_SelectionChange（ByVal Target As Range）
mandButton1。Top = Range（Cells（1； 1）； Cells（ActiveCell。Row； 1））。Rows。Height＋15
418
…………………………………………………………Page 419……………………………………………………………
End Sub
一个用 VBA 写入公式的问题
有一个这样的问题 ：统计进度以每天的日期做为文件名，如今天是2002 年 9 月 23 日，文件
名就是 2002 年 9 月 23 日。xls 工作完成后用它另存为 2002 年 9 月 24 日。xls 明天使用2002 年
9 月 24 日。xls 文件。
有一个问题 如今天是 23 日今要在a9 单元格中引用昨天 2002 年 9 月 22 日。xls 中的一个数据
公式= ＇2002 年9 月22 日。XLS＇sheet1！a10＋a7/1000 也就是昨天的一个数字加上今天的一个数据
除以 1000 每天改公式烦死了 能不能做一个 auto_open 宏
＇2002 年 9 月 22 日。XLS＇sheet1！a10＋a9/1000
红字这段自动变成 today…1 也就是昨天的日期，
我试了好几次没有成功 请 vba 高手指点
解答：
时间原因，做得很简单，你可以自己加一点 Error 语句，在运行宏之前检查昨天的文件是否存
在等等，建议不要放在 auto_open（）里，如果要必须放，要加语句检查一下宏运行的次数，不
可重复运行。以下语句在 Excel XP 中通过检测。
Sub auto_open（）
Dim dataToday； dateLastday As String
dateToday = CStr（Date）
dateLastday = CStr（Date 1）
ChDir 〃C：”
Workbooks。Add
ActiveWorkbook。SaveAs Filename：=dateToday
Cells（9； 1）。Select
ActiveCell。FormulaR1C1 = 〃='＇〃 & dateLastday & 〃。xls＇Sheet1'！R9C1＋'＇〃 & dateLastday
& 〃。xls＇Sheet1'！R10C1/1000〃
End Sub
又问：如果日期后面还有文字怎么办？
答：dateToday=CStr（Date） & 〃（你要加的文字尽管放）〃
怎么能在 excel 没打开文件的时候被禁用
如何能让一个宏命令按钮在无文件打开状态下被禁用？
解答：例如这个按钮在 Standard 工具列，名字叫 GO（&C），做法如下：
在 personal 增加一个 class
Public WithEvents App As Application
Private Sub App_WorkbookActivate（ByVal Wb As Workbook）
Application。mandBars（〃Standard〃）。Controls（〃GO（&C）〃）。Enabled = True
End Sub
Private Sub App_WorkbookDeactivate（ByVal Wb As Workbook）
Application。mandBars（〃Standard〃）。Controls（〃GO（&C）〃）。Enabled = False