资源管理站

EXCEL表格及VBA工程常用代码收藏

admin 8644 0

特别声明:本文为原创,可自由转载、引用,但需署名作者且注明文章出处,如有侵权请联系!

EXCEL表格及VBA工程常用代码收藏

获取“信息”表C列有效行数,代码如下:

Dim i As Integer
n = Sheets("信息").Range("C65536").End(xlUp).Row

打印当前页面

'打印活动表格
ActiveSheet.PrintOut
'打印指定表格
Sheets("数据").PrintOut

EXCEL VBA工程让程序休眠1秒钟

'首先在最上部,定义
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'在程序中使用,1000 为1秒钟:
Sleep 1000

判断指定路径文件是否存在

'定义函数
Function IsFileExists(ByVal strFileName As String) As Boolean
    If Dir(strFileName, 16) <> Empty Then
        IsFileExists = True
    Else
        IsFileExists = False
    End If
End Function
'使用
If IsFileExists("ThisWorkbook.Path & "\image\123.jpg") = True Then
    ' 文件存在时的处理
        MsgBox "文件存在!"
    Else
    ' 文件不存在时的处理
        MsgBox "文件不存在!"
End If

表格取消保护表格和增加保护

ActiveSheet.Unprotect '取消保护
ActiveSheet.Protect '保护工作表

打开指定文件夹所有表格

Function run()
    Dim myPath$, myFile$, AK As Workbook
    Application.ScreenUpdating = False '冻结屏幕,以防屏幕抖动
    myPath = ThisWorkbook.Path & "\image\人员证件\" '存放工作簿的文件夹
    myFile = Dir(myPath & "*.xls") '依次找寻指定路径中的*.xls文件
    Do While myFile <> "" '当指定路径中有文件时进行循环
            If myFile <> ThisWorkbook.Name Then
            Set AK = Workbooks.Open(myPath & myFile) '打开符合要求的文件
                If IsEmpty(Cells(1, 1)) Then
                Rows("1:3").Select
                Selection.Delete Shift:=xlUp
                End If
            End If
        AK.Close SaveChanges:=True '参数是否保存,为缶时需要手动关闭文件
        myFile = Dir '找寻下一个*.xls文件
    Loop
    Application.ScreenUpdating = True '解除冻结屏幕
End Function

评论列表 (已有0条评论)

消灭零回复

发表评论 (已有0条评论)

icon_lol.gif2016zhh.gif2016fendou.gif2016lengh.gificon_exclaim.gif2016gg.gif2016yhh.gificon_cry.gif2016bs.gif2016qd.gif2016bz.gificon_eek.gif2016ka.gif2016zhem.gificon_confused.gif2016qq.gif2016db.gif2016jk.gif2016tuu.gif2016zk.gif2016kk.gificon_neutral.gif