【OA】EXCEL常用VBA总结

对EXCEL一些定义的理解纠正

工作簿&工作表

• 用了这么长时间的EXCEL，今天算是给懵了，在和别人交流的过程中我把工作簿和表的概念混淆了，造成了一些本来可以避免的误会和错误，然后就百度了一下EXCEL中的最最基本的概念：所谓工作簿是指Excel环境中用来储存并处理工作数据的文件。也就是说Excel文档就是工作簿。它是Excel工作区中一个或多个工作表的集合，其扩展名为XLS,在Excel中，用来储存并处理工作数据的文件叫做工作簿。每一本工作簿可以拥有许多不同的工作表，工作簿中最多可建立255个工作表。（来自百度百科）

常用的一些好玩的VBA

• 其实我觉得真正的高手用VBA的很少，毕竟VBA有一些自己本身的先天缺陷，最简单的例子就是宏病毒。那么高手玩家都玩啥呢？那就是EXCEL函数，EXCEL函数的一些高端用法就不在这里介绍了，毕竟我也不是一个高端EXCEL玩家。

• 下面就整理一些我自己在网上淘来的常用的VBA吧：

排版篇

一键调整行高

• 有时候真的不想费劲巴拉的去用鼠标设置行高，用个宏就把所有表格的行高统一设定。

Private Sub CommandButton1_Click()
    Dim i, HangGao
    Rows("1:100").EntireRow.AutoFit
    HangGao = InputBox("已设定自适应行高，设定想增加的行高", "增加行高")
    Application.ScreenUpdating = False
    For i = 1 To 100
        Rows(i).RowHeight = Rows(i).RowHeight + CVar(HangGao)
    Next i
    Application.ScreenUpdating = True
End Sub

'选中前100行，然后自动根据内容调整到合适的行高，就跟你选中以后双击黑线是一样的效果。  然后在弹出的对话框中输入你想要每行增加行高的数值，每个行高就加你输入的数值。

• 效果如下：

奇偶页分别打印

• 有时候拍完版在装订的时候总是希望奇数和偶数页区分开来打印，那就得用到下面的VBA了。

Sub 奇偶页分别打印()
  Dim i%, Ps%
  Ps = ExecuteExcel4Macro("GET.DOCUMENT(50)") '总页数
  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

取消原分页符

Sub 取消原分页()
    Cells.Select
    ActiveSheet.ResetAllPageBreaks
End Sub

删除全部未选定工作表

Sub 删除全部未选定工作表()
    Dim sht As Worksheet, n As Integer, iFlag As Boolean
    Dim ShtName() As String
    n = ActiveWindow.SelectedSheets.Count
    ReDim ShtName(1 To n)
    n = 1
    For Each sht In ActiveWindow.SelectedSheets
        ShtName(n) = sht.Name
        n = n + 1
    Next
    Application.DisplayAlerts = False
    For Each sht In Sheets
        iFlag = False
        For i = 1 To n - 1
            If ShtName(i) = sht.Name Then
                iFlag = True
                Exit For
            End If
        Next
        If Not iFlag Then sht.Delete
    Next
    Application.DisplayAlerts = True
End Sub

区域高亮

高亮显示行（工作表代码）
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Interior.ColorIndex = 2
Rows("1:2").Interior.ColorIndex = 40     '保持1至2行的颜色推荐39,22,40,
Rows(Target.Row).Interior.ColorIndex = 35      '高亮推荐颜色

35,20,24,34,37,40,15
End Sub
高亮显示行和列（工作表代码）
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Interior.ColorIndex = xlNone
Rows(Target.Row).Interior.ColorIndex = 34
Columns(Target.Column).Interior.ColorIndex = 34
End Sub

安全篇

解除全部工作表保护

Sub 解除全部工作表保护()
Dim n As Integer
    For n = 1 To Sheets.Count
        Sheets(n).Unprotect
    Next n
End Sub

为指定工作表加指定密码保护

Sub 为指定工作表加指定密码保护表()
Sheet10.Protect Password:="123"
End Sub

在有密码的工作表执行代码

Sub 在有密码的工作表执行代码()
Sheets("1").Unprotect Password:=123 '假定表名为“1”，密码为“123”  打开工作

表
Range("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True   '隐藏C

列空值行
Sheets("1").Protect Password:=123    '重新用密码保护工作表
End Sub

执行前需要验证密码的VBA

• 如果不想手哆嗦的时候让自己的成果灰飞烟灭那就还是加一个保护吧！

Sub 执行前需要验证密码的宏()
If InputBox("请输入您的使用权限:", "系统提示") = 123 Then
重排窗口   '要执行的宏代码或宏名称
Else
MsgBox "对不起,您没有使用该宏的权限,按确定键后退出!"
End If
End Sub

当修改特定单元格时自动执行VBA

当修改指定单元内容时自动执行宏（工作表代码）
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, [B3:B4]) Is Nothing Then
  重排窗口
End If
End Sub

双击单元隐藏该行（工作表代码）

双击单元隐藏该行（工作表代码）
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As 

Boolean)
  Rows(Target.Row).Hidden = True
End Sub

锁定/解除工作区域

为指定工作表设置滚动范围（工作簿代码）
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Sheet1.ScrollArea = "A1:M30"
End Sub

在指定单元记录打印和预览次数（工作簿代码）
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Range("A1") = 1 + Range("A1")
End Sub

指定允许编辑区域
Sub 指定允许编辑区域()
ActiveSheet.ScrollArea = "B8:G15"
End Sub

解除允许编辑区域限制
Sub 解除允许编辑区域限制()
ActiveSheet.ScrollArea = ""
End Sub

功能篇

闹钟

闹钟——到指定时间执行宏（工作簿代码）
Private Sub Workbook_Open()
Application.OnTime ("11:45:00"), "提示1"    '宏名字
Application.OnTime ("12:00:00"), "提示2"    '宏名字
End Sub