excel常用宏集合(4)

Else 'Sort descending For i = 1 To nums For j = i To nums

If UCase(Sheets(j).Name) > UCase(Sheets(i).Name) Then Sheets(j).Move Before:=Sheets(i) End If Next j Next i End If End Sub

259个常用宏-excelhome(2) 2009-08-15 14:11:45

45：定义指定工作表标签颜色

Sub 定义指定工作表标签颜色()

Sheets(\End Sub

46：在目录表建立本工作簿中各表链接目录

Sub 在目录表建立本工作簿中各表链接目录() Dim s%, Rng As Range On Error Resume Next Sheets(\目录\ If Err = 0 Then

Sheets(\目录\ Else

Sheets.Add

ActiveSheet.Name = \目录\ End If

For i = 1 To Sheets.Count

If Sheets(i).Name <> \目录\ s = s + 1

Set Rng = Sheets(\目录\

Rng = Format(s, \

ActiveSheet.Hyperlinks.Add Rng, \& Sheets(i).Name & \ScreenTip:=Sheets(i).Name End If Next

Sheets(\目录\End Sub

47：建立工作表文本目录

Sub 建立工作表文本目录()

Sheets.Add before:=Sheets(1) Sheets(1).Name = \目录\ For i = 2 To Sheets.Count

Cells(i - 1, 1) = Sheets(i).Name

'Sheets(1).Hyperlinks.Add Cells(i - 1, 1), \ Next End Sub

48：查另一文件的所有表名

Sub 查另一文件的所有表名() On Error Resume Next Dim i%

Dim sh As Worksheet

Application.ScreenUpdating = False

Workbooks.Open Filename:=ThisWorkbook.Path & \ Windows(\当前文件名称 Sheets(\ '当前表名称

i = 1 '将表名称返回到第1行 For Each sh In Workbooks(\

Cells(i, 1) = sh.Name '将表名称返回到第1列 i = i + 1 '返回每个表名称向下移动1行 Next sh

Windows(\ '关闭对象文件 Application.ScreenUpdating = True End Sub

49：当前单元录入计算机名

'添加超链接 Sub 当前单元录入计算机名()

Selection = Environ(\

'Selection = Workbooks(\临时表\表2\调用指定地址内容 End Sub

50：当前单元录入计算机用户名

Sub 当前单元录入计算机用户名() Selection = Environ(\

'Selection = Workbooks(\临时表\表2\调用指定地址内容 End Sub

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(\= True '隐藏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