excel常用宏集合(2)

RunMacro = 1 Case 1 宏2

RunMacro = 2 Case 2 宏3

RunMacro = 0 End Select End Sub

10：在两个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）

Private Sub CommandButton1_Click() With CommandButton1

If .Caption = \保护工作表\ Call 保护工作表

.Caption = \取消工作表保护\ Exit Sub End If

If .Caption = \取消工作表保护\ Call 取消工作表保护 .Caption = \保护工作表\ Exit Sub End If End With End Sub

11：在三个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）

Option Explicit

Private Sub CommandButton1_Click() With CommandButton1

If .Caption = \宏1\ Call 宏1

.Caption = \宏2\ Exit Sub End If

If .Caption = \宏2\ Call 宏2

.Caption = \宏3\ Exit Sub End If

If .Caption = \宏3\ Call 宏3

.Caption = \宏1\ Exit Sub End If End With End Sub

12：根据A1单元文本隐藏/显示按钮（控件按钮代码）

Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Range(\

CommandButton1.Visible = 1 Else

CommandButton1.Visible = 0 End If End Sub

Private Sub CommandButton1_Click() 重排窗口 End Sub

13：当前单元返回按钮名称（控件按钮代码）

Private Sub CommandButton1_Click() ActiveCell = CommandButton1.Caption End Sub

14：当前单元内容返回到按钮名称（控件按钮代码）

Private Sub CommandButton1_Click() CommandButton1.Caption = ActiveCell End Sub

15：奇偶页分别打印

Sub 奇偶页分别打印() Dim i%, Ps%

Ps = ExecuteExcel4Macro(\总页数 MsgBox \现在打印奇数页,按确定开始.\For i = 1 To Ps Step 2

ActiveSheet.PrintOut from:=i, To:=i Next i

MsgBox \现在打印偶数页,按确定开始.\For i = 2 To Ps Step 2

ActiveSheet.PrintOut from:=i, To:=i Next i End Sub

16：自动打印多工作表第一页

Sub 自动打印多工作表第一页() Dim sh As Integer Dim x Dim y Dim sy Dim syz

x = InputBox(\请输入起始工作表名字:\sy = InputBox(\请输入结束工作表名字:\y = Sheets(x).Index syz = Sheets(sy).Index For sh = y To syz Sheets(sh).Select

Sheets(sh).PrintOut from:=1, To:=1 Next sh End Sub

17：查找A列文本循环插入分页符

Sub 循环插入分页符()

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

Dim i As Long Dim times As Long

times = Application.WorksheetFunction.CountIf(Sheet1.Range(\分页\

'times代表循环次数，执行前把times赋值即可(不可小于1，不可大于2147483647) For i = 1 To times Call 插入分页符 Next i End Sub

Sub 插入分页符()

Cells.Find(What:=\分页\

xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _ .Activate

ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell End Sub

Sub 取消原分页() Cells.Select

ActiveSheet.ResetAllPageBreaks End Sub

18：将A列最后数据行以上的所有B列图片大小调整为所在单元大小

Sub 将A列最后数据行以上的所有B列图片大小调整为所在单元大小() Dim Pic As Picture, i&

i = [A65536].End(xlUp).Row For Each Pic In Sheet1.Pictures

If Not Application.Intersect(Pic.TopLeftCell, Range(\ Pic.Top = Pic.TopLeftCell.Top Pic.Left = Pic.TopLeftCell.Left

Pic.Height = Pic.TopLeftCell.Height Pic.Width = Pic.TopLeftCell.Width End If Next End Sub

19：返回光标所在行数

Sub 返回光标所在行数() x = ActiveCell.Row Range(\End Sub

20：在A1返回当前选中单元格数量

Sub 在A1返回当前选中单元格数量() [A1] = Selection.Count End Sub

21：返回当前工作簿中工作表数量

Sub 返回当前工作簿中工作表数量() t = Application.Sheets.Count MsgBox t End Sub

22：返回光标选择区域的行数和列数

Sub 返回光标选择区域的行数和列数() x = Selection.Rows.Count y = Selection.Columns.Count Range(\ Range(\End Sub

23：工作表中包含数据的最大行数

Sub 包含数据的最大行数()

n = Cells.Find(\ MsgBox n End Sub

24：返回A列数据的最大行数

Sub 返回A列数据的最大行数()

n = Range(\ Range(\End Sub

25：将所选区域文本插入新建文本框

Sub 将所选区域文本插入新建文本框() For Each rag In Selection

n = n & rag.Value & Chr(10) Next

ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, ActiveCell.Left ActiveCell.Width, ActiveCell.Top + ActiveCell.Height, 250#, 100).Select Selection.Characters.Text = \问题：\

With Selection.Characters(Start:=1, Length:=3).Font .Name = \黑体\ .FontStyle = \常规\

+