Excel word ppt office使用技巧大全(DOC格式)-第75部分
按键盘上方向键 ← 或 → 可快速上下翻页，按键盘上的 Enter 键可回到本书目录页，按键盘上方向键 ↑ 可回到本页顶部！
————未阅读完？加入书签已便下次继续阅读！
B1 = B2
I3 = I3 1
MsgBox （B1）； ； 〃差额数量〃
GoTo LINE4：
End If
Else
B1 = B1 ＋ Cells（I3； H ＋ 1）。Value
I3 = I3 1
GoTo LINE4：
End If
使用了循环语句
使用了 b1 b2 b3 作为数量的传递。
简单测试通过。
一个加密系统
在打开 EXCEL 时，先运行我的加密窗口（用 VBA 编写的 LOCK。frm），现在请问，如何在当关闭
…加密窗口 （lock。frm）时，自动关闭 EXCEL？？我曾经见过其它 EXCEL 模块有此功能，但不知
如何编写的。
解答：********ThisWorkbook program *********
Private Sub Workbook_Open（）
UserForm1。Show
End Sub
*********** UserForm1 program *********
Private Sub mandButton1_Click（）
UserForm1。Hide
If UCase（input1） 〃ULOCK〃 Then 'input1》》textbox
399
…………………………………………………………Page 400……………………………………………………………
MsgBox 〃密码错误〃
ActiveWindow。Close
End If
MsgBox 〃欢迎使用本系统。。。。。。。〃
End Sub
在不同工作表里位置相同的单元格里相同的公式，根据工作表名称引用不同的单元格
解答：如果工作表的名称做的有规律就比较简单，可以用变量生成序号，然后合成工作表名
称，比如：
i=5
j=〃sheets〃＋ctsr（i）
m=j。cells（2；1）。value
更改 i 的值就能引用不同工作表了。
如果没有规律，可以求工作表的序号，进而得到工作表的名称，然后如何引用就很类似了。
快速撤销工作表保护
有一工作表，在其中的几列中有计算公式，比如 B、F、K 列等，且其中有一列公式使用的函数
为 HYPERLINK（），直接点击该单元格时会打开一个网页。当我要在工作表中进行插入行操作时，
如何快速完成如下工作：1：撤销工作表保护；2、将所有公式复制到新插入行中；3、进行工
作表保护。
如果使用宏该如何设计？
解答：1。在你的宏前先取消保护
ActiveSheet。Unprotect （〃1234〃）
此例假设密码为 1234
执行完宏再次保护工作表
ActiveSheet。Protect Password：=〃1234〃
此例假设密码 1234。
2：你的第 1；3 问如楼上所说，或写个过程：
Sub sSheetProtect（Protect As Boolean）
With ActiveSheet
If 。ProtectContents = True Then
。Unprotect Password：=〃password〃
End If
If Protect = True Then
If 。ProtectContents = False Then
。Protect Password：=〃password〃； DrawingObjects：=True；
Contents：=True； Scenarios：=True
End If
End If
End With
End Sub
第 2 个问：
Rows（〃4：4〃）。Insert Shift：=xlDown
400
…………………………………………………………Page 401……………………………………………………………
Rows（〃3：3〃）。Copy
Rows（〃4：4〃）。PasteSpecial Paste：=xlFormulas
关于加密窗口的问题
问题一：关于加密窗口的问题！上次请教了一个关闭 EXCEL 函数的问题！现在又发现一个问题：
即在VBA 的FRM 窗口右上方的“X”如果去掉？因为它关闭了我的加密窗口就不起作用？或者
如果按“X”的时候，自动关闭EXCEL 就行，如何？问题二，我每次经过加密窗口后进入工作
表，总是被隐藏了，用什么函数把隐藏的 自动打开？
解答：1、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
2、Sub dd（）
For i = 1 To Worksheets。Count
Sheets（i）。Visible = True
Next i
End Sub
加密窗口为何总是出现 424 出错信息
*********** UserForm1 program *********
Private Sub mandButton1_Click（）
UserForm1。Hide /// 这里总是出错 424
If UCase（input1） 〃ULOCK〃 Then 'input1》》textbox
MsgBox 〃密码错误〃
ActiveWindow。Close
End If
MsgBox 〃欢迎使用本纟统。。。。。。。〃
End Sub
解答：1。你要先自订 Form；Form 的名称为UserForm1
2。form 中有 textbox 设名称为 input1
以上若未设则error
我在做自定义菜单欲仿 EXCEL 菜单用横线分隔各菜单项目
解答：下面是我用到的代码：
Set mymenubar = mandBars。ActiveMenuBar
Set newmenu1 = mymenubar。Controls。Add（Type：=msoControlPopup； _
Temporary：=True）
newmenu1。Caption = 〃文件制作 （&M）〃
newmenu1。BeginGroup = True '这就是你要的白色横线
用 VBA 函数算出行数值
解答：如在 A 列有数据
Sub pd（）
401
…………………………………………………………Page 402……………………………………………………………
a = 1
Do Until Cells（a； 1） = 〃〃
a = a ＋ 1
Loop
行数 = a 1
End Sub
解答 2：假如数据在A 列，试试这个，中间有空单元格也没关系，
Right（Sheet1。Columns（1）。SpecialCells（xlCellTypeConstants； xlNumbers ＋
xlTextValues）。Address； 1）
再问解答 2：你整怎么复杂，是什么意思哟？
解答：研究研下面宏你就会明白了
Sub kkk（）
ActiveSheet。Cells（2； 1） = 〃Text1〃
ActiveSheet。Cells（4； 1） = 2
ActiveSheet。Cells（5； 1） = 〃Text2〃
ActiveSheet。Cells（8； 1） = 3
MsgBox ActiveSheet。Columns（1）。SpecialCells（xlCellTypeConstants； _
xlNumbers）。Address
MsgBox ActiveSheet。Columns（1）。SpecialCells（xlCellTypeConstants； _
xlTextValues）。Address
MsgBox ActiveSheet。Columns（1）。SpecialCells（xlCellTypeConstants； _
xlNumbers ＋ xlTextValues）。Address
End Sub
在 VBA 中判断单元格区域内是否为空值
解答：用循环语句
Sub kg（）
Dim mycell As Range
For Each mycell In Range（〃a1：e9〃）
If mycell = 〃〃 Then mycell = 1000
Next mycell
End Sub
Sub sumrange（）
Dim mycell As Range
For Each mycell In Range（〃a1：e9〃）
If mycell 〃〃 Then myresult = mycell＋myresult
Next mycell
End Sub
excel 中如何设定光标输入到某个单元格后回车自动换行
解答：Option Explicit
Const ColumnOfTheCell2BeReturn As Integer = 5 '到第 5 列换行
'指定单元格中按回车键自动换行
402
…………………………………………………………Page 403……………………………………………………………
Private Sub Worksheet_SelectionChange（ByVal Target As Range）
Static LastRow As Integer
Dim R％； C％
R = Target。Row：
C = Target。Column
If Application。MoveAfterReturnDirection = …4161 Then '按回车光标右移
If C = ColumnOfTheCell2BeReturn ＋ 1 Then Cells（R ＋ 1； 1）。Select
End If
If Application。MoveAfterReturnDirection = …4121 Then '按回车光标下移
If C = ColumnOfTheCell2BeReturn And （R LastRow = 1） Then Cells（R； 1）。Select
End If
LastRow = R
End Sub
修改上面解答：Private Sub Worksheet_SelectionChange（ByVal Target As Range）
Static LastColumn As Integer
C = Target。Column
Select Case Target。Column
Case 5
Application。MoveAfterReturn = False 'STOP
'Cells（Target。Row ＋ 1； 1）。Select '第一格
Case Is 《 5
Application。MoveAfterReturn = True
Application。MoveAfterReturnDirection = xlToRight '右移
Case Is 》 5
Application。MoveAfterReturn = True
Application。MoveAfterReturnDirection = xlDown '下移
End Select
If C = 5 And C = LastColumn Then Cells（Target。Row ＋ 1； 1）。Select
LastColumn = C
End Sub
带编号的（000001 ………999999）在打印时实现自动编号
解答：Sub 序号打印 （）
Dim lsh As Integer
lsh = 0
Do While lsh
