EXCEL宏编辑命令(3)

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:=\分页\alues, LookAt:= _

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 = \常规\ .Size = 12 End With End Sub

26、批量插入地址批注

Sub 批量插入地址批注() On Error Resume Next

+

Dim r As Range

If Selection.Cells.Count > 0 Then For Each r In Selection r.Comment.Delete r.AddComment

r.Comment.Visible = False

r.Comment.Text Text:=\本单元格：\ Next End If End Sub

27、批量插入统一批注

Sub 批量插入统一批注()

Dim r As Range, msg As String

msg = InputBox(\请输入欲批量插入的批注\提示\随便输点什么吧\ If Selection.Cells.Count > 0 Then For Each r In Selection r.AddComment

r.Comment.Visible = False r.Comment.Text Text:=msg Next End If End Sub

28、以A1单元内容批量插入批注

Sub 以A1单元内容批量插入批注() Dim r As Range

If Selection.Cells.Count > 0 Then For Each r In Selection r.AddComment

r.Comment.Visible = False

r.Comment.Text Text:=[a1].Text Next End If End Sub

29、不连续区域插入当前文件名和表名及地址

Sub 批量插入当前文件名和表名及地址()

百度搜索“77cn”或“免费范文网”即可找到本站免费阅读全部范文。收藏本站方便下次阅读，免费范文网，提供经典小说综合文库EXCEL宏编辑命令(3)在线全文阅读。