Excel word ppt office使用技巧大全(DOC格式)-第77部分
按键盘上方向键 ← 或 → 可快速上下翻页，按键盘上的 Enter 键可回到本书目录页，按键盘上方向键 ↑ 可回到本页顶部！
————未阅读完？加入书签已便下次继续阅读！
End Sub
文件保存为以某一单元格中的值为文件名的宏怎么写
用命令： ActiveWorkbook。SaveCopyAs Str（Range（〃Sheet1！A1〃）） ＋ 〃。xls〃
410
…………………………………………………………Page 411……………………………………………………………
自动处理某种格式
Q： 请问有什么方法可以把相关列的内容自动形成一种格式？如：
日期 商品 金额/1…1 A材料 50 /1…1 B材料 40 /1…2 C 材料 70/1…2 A 材料 34/1…3 C 材料 99 。
上述的表格中，“商品”与“金额”是相关系的，请问有什么方法，使当商品是 A 材料时、它
自动填充上蓝色和成为白色字，“金额”字段也自动作相应的填充上蓝色和是白色字？
即：
A B C
1 日期 商品 金额 /2 1…1 A 材料 50 （蓝底、白字）/3 1…1 B 材料 40 /4 1…2 C 材料 70 （黄
底、红字） /5 1…2 A 材料 34 （蓝底、白字） /6 1…3 C 材料 99 （黄底、红字） /使用“条
件格式”做不到，如用“排序”方法先选出再填充颜色等又会影响其它字段的计算，因而请教
各位是否有什么方法（例如宏）等可设定自动处理上述问题？先谢谢。
A： wildgoose
我可以提供一份变通的办法：你可以插入三列，一列用来用来存放你的材料名称，一列放 1、
2、3。。。数字，然后在第三列中用 vlookup 函数取出对应材料名称的数字。后使用 条件格式 ，
通过判断 1、2、3。。。 就可以了
A：dick
Private Sub Worksheet_Change（ByVal Target As Range）
X = ActiveCell。Row（） ' 目前位置
Y = ActiveCell。Column（）
L = ＇b65535＇。End（xlUp）。Row（） '计算共有几笔
For I = 0 To L 2
A = ＇b65535＇。End（xlUp）。Offset（…I； 0） '
Select Case A
Case 〃A 材料〃
＇b65535＇。End（xlUp）。Offset（…I； 0）。Select 'B
Selection。Font。ColorIndex = 2
Selection。Interior。ColorIndex = 5
＇b65535＇。End（xlUp）。Offset（…I； 1）。Select 'A
Selection。Font。ColorIndex = 2
Selection。Interior。ColorIndex = 5
＇b65535＇。End（xlUp）。Offset（…I； …1）。Select 'C
Selection。Font。ColorIndex = 2
Selection。Interior。ColorIndex = 5
Case 〃B 材料〃
Case 〃C 材料〃
＇b65535＇。End（xlUp）。Offset（…I； 0）。Select
Selection。Font。ColorIndex = 3
Selection。Interior。ColorIndex = 6
＇b65535＇。End（xlUp）。Offset（…I； 1）。Select
Selection。Font。ColorIndex = 3
Selection。Interior。ColorIndex = 6
411
…………………………………………………………Page 412……………………………………………………………
＇b65535＇。End（xlUp）。Offset（…I； …1）。Select
Selection。Font。ColorIndex = 3
Selection。Interior。ColorIndex = 6
End Select
Next I
Cells（X； Y）。Select '动作前单元格
End Sub
A：Rowen
选中 B2…》格式…》条件格式…》公式…》=（LEFT（B2；1）=〃A〃）…》设定字体及图案。添加公式…》类
推。。。用格式刷填充到所需单元格。条件格式最多可设定三个；多过请用 VBA 实现
在 VBA 的FRM 窗口右上方的“X”如果去掉
Q：问题一：关于加密窗口的问题！上次请教了一个关闭 EXCEL 函数的问题！现在又发现一个问
题：即在 VBA 的FRM 窗口右上方的“X”如果去掉？因为它关闭了我的加密窗口就不起作用？
或者如果按“X”的时候，自动关闭EXCEL 就行，如何？多谢！
问题二，我每次经过加密窗口后进入工作表，总是被隐藏了，用什么函数把隐藏的自动打开？
这样我的可以写一个宏！OK！
A： tof
Private Sub UserForm_QueryClose（Cancel As Integer； CloseMode As Integer）
If CloseMode 1 Then Cancel = 1
UserForm1。Caption = 〃The Close box won't work！ Click me！〃
End Sub
dick
Sub dd（）
For i = 1 To Worksheets。Count
Sheets（i）。Visible = True
Next i
End Sub
vba for excel 程序纠错
Q：我想对所有工作表进行将公式转为数值，录制宏后加上了几句但结果不对，请斧正！
sub aa（）
dim sht as worksheet
For Each sht In Worksheets
ActiveSheet。Range（〃A1：C4〃）。Select
Selection。Copy
Selection。PasteSpecial Paste：=xlValues； Operation：=xlNone； SkipBlanks：= _
False； Transpose：=False
ActiveSheet。Paste
Application。CutCopyMode = False
Next
412
…………………………………………………………Page 413……………………………………………………………
End Sub
A： roof
试试在 for。。。each。。。和 activesheet。。。之间加上一句“sht。activate〃。结果如下：
sub aa（）
dim sht as worksheet
For Each sht In Worksheets
sht。activate
ActiveSheet。Range（〃A1：C4〃）。Select
Selection。Copy
Selection。PasteSpecial Paste：=xlValues； Operation：=xlNone； SkipBlanks：= _
False； Transpose：=False
ActiveSheet。Paste
Application。CutCopyMode = False
Next
End Sub
excelhelp：其实录制得来的宏（macro）程序可以自行修改，以达到高效率、精简的目的。你
的程序这样改会较容易看得懂，记着，Selection 一般可以省去，使程序一气呵成，也可以避
免现存储存格（activecell，浮标所在地）给移动。
Sub aa（）
Dim Sht As Worksheet
For Each Sht In Worksheets
With Sht。Range（〃A1：C4〃）
。Copy
。PasteSpecial Paste：=xlValues； Operation：=xlNone； SkipBlanks：=False；
Transpose：=False
End With
Application。CutCopyMode = False
Next
End Sub
虽然以上的程序可以把 A1：C4 的公式删去，但它有两个缺点：
１）范围只能限定为A1：C4，要是多了一个不在此范围的储存格（cell）有公式，又或是每张
工作表（worksheet）的范围都不一样，这程序便会有问题；
２）在宏执行时，画面会闪动，这是Copy 和 Paste 的副作用。
故此，我建议用以下程序代替：
Sub aa2（）
Dim wSht As Worksheet
Dim rCell As Range
For Each wSht In Worksheets
For Each rCell In wSht。UsedRange
rCell。Value = rCell。Value
Next
Next
413
…………………………………………………………Page 414……………………………………………………………
End Sub
这样写较简洁，也没有上述的问题。
leaf ：Sub aa（）
Dim sht as WorkSheet
Dim rng as Range
For Each sht In Worksheets
Set rng = sht。Cells
With rng
。Copy
。PasteSpecial Paste：=xlValues
End With
Application。CutCopyMode = False
Next
End Sub
请问各位有什么方法可以使工作表从 1 至 50 自动排列
Sub paixu（）
For i = 1 To Sheets。Count
For j = i To Sheets。Count
If Int（Sheets（i）。Name） 》 Int（Sheets（j）。Name） Then
Sheets（j）。Move Before：=Sheets（i）
End If
Next j
Next i
End Sub
如何将自动将公式的值固定在单元格
我又有新问题了。怎么样在一定的条件下将公式转换成值固定在在单元格内？
解答：Private Sub Workbook_SheetSelectionChange（ByVal Sh As Object； ByVal Target As
Excel。Range）
With ThisWorkbook。ActiveSheet
If Target。Column = 3 And Target。Row 》 1 Then
If VBA。Trim（。Cells（Target。Row； 4）。Value） = 〃counting〃 Then
Target。Value = 。Cells（Target。Row； 2） 。Cells（Target。Row； 1）
End If
End If
End With
End Sub
将这段内容加入到 thisworkbook 模块中，在你选中要计算的单元格时，会为你自动计算，当
然你也可以修改一下使其完全自动化。
414
…………………………………………………………Page 415……………………………………………………………
输入字母转换成设定的数值
比如，我设置第一个框的范围是（a=2。7 b=1。8 c=0。9 d=0）如果我输入c，那它能不能变成
0。9 或者最后相加减的时候转换？
解答：Private Sub Workbook_SheetChange（ByVal Sh As Object； ByVal Target As Range）
If Target。Value = 〃a〃 Then
Target。Value = 2。7
ElseIf Target。Value = 〃b〃 Then
Target。Value = 1。8
ElseIf Target。Value = 〃c〃 Then
Target。Value = 0。9
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
