51、解除全部工作表保护
Sub 解除全部工作表保护() Dim n As Integer
For n = 1 To Sheets.Count Sheets(n).Unprotect Next n End Sub
52、为指定工作表加指定密码保护表
Sub 为指定工作表加指定密码保护表() Sheet10.Protect Password:=\End Sub
53、在有密码的工作表执行代码
Sub 在有密码的工作表执行代码()
Sheets(\假定表名为“1”，密码为“123”打开工作表 Range(\ '隐藏C列空值行 Sheets(\ '重新用密码保护工作表 End Sub
54、执行前需要验证密码的宏(控件按钮代码)
Private Sub CommandButton1_Click()
If InputBox(\请输入密码：\密码是123 MsgBox \密码错误,按确定退出!\提示\ Exit Sub End If
Cells(1, 1) = 10 End Sub
55、执行前需要验证密码的宏()
Sub 执行前需要验证密码的宏()
If InputBox(\请输入您的使用权限:\系统提示\重排窗口 '要执行的宏代码或宏名称 Else
MsgBox \对不起,您没有使用该宏的权限,按确定键后退出!\ End If End Sub
56、拷贝A1公式和格式到A2
Sub 拷贝A1公式到A2()
Workbooks(\临时表\表1\
Workbooks(\临时表\表2\End Sub
57、复制单元数值
Sub 复制数值()
s = Workbooks(\ Workbooks(\End Sub
58、插入数值条件格式
Sub 插入数值条件格式()
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _ Formula1:=\
Selection.FormatConditions(1).Interior.ColorIndex = 45
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _ Formula1:=\
Selection.FormatConditions(2).Interior.ColorIndex = 39
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _ Formula1:=\
Selection.FormatConditions(3).Interior.ColorIndex = 34 End Sub
59、插入透明批注
Sub 插入透明批注()
Selection.AddComment
Selection.Comment.Visible = False Dim XS As Worksheet
For i = 1 To ActiveSheet.Comments.Count
ActiveSheet.Comments(i).Text \透明批注\
ActiveSheet.Comments(i).Shape.Fill.Visible = msoFalse Next End Sub
60、添加文本
Sub 添加文本()
Selection = Selection + \×\不可在数字后添加文本
'Selection = Workbooks(\临时表\表2\调用指定地址内容 End Sub
61、光标定位到指定工作表A列最后数据行下一单元
Sub 光标定位到指定工作表A列最后数据行下一单元() a = Sheets(\数据库\ Sheets(\数据库\ Range(\End Sub
62、定位选定单元格式相同的全部单元格
Sub 定位选定单元格式相同的全部单元格() Dim FirstCell As Range, FoundCell As Range Dim AllCells As Range
With Application.FindFormat .Clear
.NumberFormatLocal = Selection.NumberFormatLocal .HorizontalAlignment = Selection.HorizontalAlignment .VerticalAlignment = Selection.VerticalAlignment .WrapText = Selection.WrapText .Orientation = Selection.Orientation .AddIndent = Selection.AddIndent .IndentLevel = Selection.IndentLevel .ShrinkToFit = Selection.ShrinkToFit .MergeCells = Selection.MergeCells .Font.Name = Selection.Font.Name
.Font.FontStyle = Selection.Font.FontStyle .Font.Size = Selection.Font.Size
.Font.Strikethrough = Selection.Font.Strikethrough .Font.Subscript = Selection.Font.Subscript .Font.Underline = Selection.Font.Underline .Font.ColorIndex = Selection.Font.ColorIndex
.Interior.ColorIndex = Selection.Interior.ColorIndex .Interior.Pattern = Selection.Interior.Pattern .Locked = Selection.Locked
.FormulaHidden = Selection.FormulaHidden End With
Set FirstCell = ActiveSheet.UsedRange.Find(what:=\ If FirstCell Is Nothing Then Exit Sub End If
Set AllCells = FirstCell
Set FoundCell = FirstCell Do
Set FoundCell = ActiveSheet.UsedRange.Find(After:=FoundCell, what:=\searchformat:=True)
If FoundCell Is Nothing Then Exit Do Set AllCells = Union(FoundCell, AllCells)
If FoundCell.Address = FirstCell.Address Then Exit Do Loop AllCells.Select End Sub
63、按当前单元文本定位
Sub 按当前单元文本定位() ABC = Selection Dim aa As Range
For Each a In ActiveSheet.UsedRange If a Like ABC Then
If aa Is Nothing Then Set aa = a.Cells Else
Set aa = Union(aa, a.Cells) End If End If Next aa.Select End Sub
64、按固定文本定位
Sub 文本定位()
Dim aa As Range
For Each a In ActiveSheet.UsedRange If a Like \合计*\ If aa Is Nothing Then Set aa = a.Cells Else
Set aa = Union(aa, a.Cells) End If