VBA常用程序——每个表都应该有

Sub 复制位图()
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
End Sub

Sub 复制打印()
    Range("Print_Area").CopyPicture Appearance:=xlScreen, Format:=xlBitmap
End Sub

Sub 清除图片()
    For Each shp In ActiveSheet.Shapes
        If shp.Type = 13 Then shp.Delete
    Next shp
End Sub

Sub 取消筛选(Optional ob) '用于避免筛选导致清理残留
    If IsMissing(ob) Then Set ob = ActiveSheet.Cells
    ob.AutoFilter Field:=1
    ob.AutoFilter
End Sub

Function 路径文件全名(Optional path) '包括拓展名
    '空参数等同ActiveWorkbook.Name
    If IsMissing(path) Then path = ActiveWorkbook.FullName
    路径文件全名 = Mid(path, InStrRev(path, "\") + 1, Len(path))
End Function

Function 路径文件名(Optional path) '不包括拓展名
    '也可以用于去掉全名的拓展名
    If IsMissing(path) Then path = ActiveWorkbook.FullName
    路径文件名 = Mid(path, InStrRev(path, "\") + 1, InStrRev(path, ".") - InStrRev(path, "\") - 1)
End Function

Function 上级文件夹(Optional path) '不包括最后的\,如需要请加 &"\"
    '也可以用于获取路径文件夹名，空参数等同ActiveWorkbook.path
    If IsMissing(path) Then path = ActiveWorkbook.FullName
    上级文件夹 = Left(path, InStrRev(path, "\") - 1)
End Function

Sub 关闭功能() '关闭一些功能加快 VBA 宏的运行速度
'    On Error Resume Next '出错继续运行
'    Application.DisplayAlerts = False '禁用警告信息
'    Application.DisplayAlerts = True '启用警告信息
    Application.ScreenUpdating = False '禁用屏幕更新
    Application.DisplayStatusBar = False '禁用状态栏
    Application.Calculation = xlCalculationManual '切换到手动计算-4135，如果中途需要计算时用Calculate
    Application.EnableEvents = False '禁用事件
    ActiveSheet.DisplayPageBreaks = False '禁用本表分页符
End Sub

Sub 开启功能() '开启关闭的功能，调试中断可运行开启功能
    Application.ScreenUpdating = True '启用屏幕更新
    Application.DisplayStatusBar = True '启用状态栏
    Application.StatusBar = False '恢复状态栏
    Application.Calculation = xlCalculationAutomatic '切换到自动计算-4105
    Application.EnableEvents = True '启用事件
    'ActiveSheet.DisplayPageBreaks = displayPageBreaksState '启用本表分页符
End Sub

Function 立即窗口清屏()
    VBA.SendKeys "^{g}"
    VBA.SendKeys "^{a}"
    VBA.SendKeys "{del}"
End Function