分享

【VBA编程】14.操作工作簿对象

 Excel实用知识 2021-11-20

【访问工作簿】

对已经打开的工作簿,可以通过使用索引号来访问工作簿,也可以通过名称来访问工作簿

【代码区域】

复制代码
Sub 访问工作簿()
    Dim counter As Integer
    counter = Workbooks.Count
    Debug.Print
    Debug.Print '当前打开工作簿的数目为:' & CStr(counter)
    Debug.Print '按索引号访问工作簿如下:'
    Debug.Print '第一个工作簿是:' & Workbooks(1).name
    Debug.Print '第一个工作簿是:' & Workbooks(2).name
    Debug.Print '按名称访问工作簿如下:'
    Debug.Print '第一个工作簿是:' & Workbooks('VBA.xlsm').name
    Debug.Print '第一个工作簿是:' & Workbooks('TEST.xlsx').name
End Sub
复制代码

【打印结果】

现在打开的工作簿为:

【获取工作簿信息】

【代码区域】

复制代码
Sub 获取工作簿信息()
    Dim wb As Workbook
    Set wk = Workbooks(1)
    wk.Activate
    Debug.Print
    Debug.Print '当前Excle文档的信息如下:'
    Debug.Print '工作簿的名称为:' & wk.name
    Debug.Print '工作簿的保存位置为:' & wk.Path
    Debug.Print '工作簿是否只读:' & CStr(wk.ReadOnly)
    Debug.Print '工作簿的全名为:' & wk.FullName
    Debug.Print '工作簿是否需要密码:' & wk.HasPassword
End Sub
复制代码

【结果展示】

【新建工作簿】

【代码区域】

复制代码
Sub 新建工作簿()
    Dim wb As Workbook
    Dim wk As Worksheet
    Rem 设置初始化工作簿中默认的工作表数目
    Application.SheetsInNewWorkbook = 2
    Set wb = Workbooks.Add '新建工作簿
    Set ws = wb.Sheets(1)
    ws.name = '产品'
    Set ws = wb.Sheets(2)
    ws.name = '原料'
    Rem 恢复初始工作簿中默认的工作表
    Application.SheetsInNewWorkbook = 3
    MsgBox '成功完成了新建工作簿!', vbOKOnly, '新建工作簿'
    Set wb = Nothing
    Set ws = Nothing
End Sub
复制代码

【结果展示】

                                                                                                 

【使用对话框打开工作簿】

【代码区域】

Sub 使用对话框打开工作簿()
    Dim fileInformation As String
    fileInformation = Application.GetOpenFilename('Excle 工作簿(*.xlsx),*.xlsx')
End Sub

【结果展示】

 

【备份工作簿】

【代码区域】

复制代码
Sub 备份工作簿()
    Dim wk As Workbook
    Dim mypath As String
    Dim myfile As String
    Dim filefull As String
    Set wk = Workbooks(1)
    wk.Activate
    mypath = wk.Path
    myfile = '备份' + wk.name
    filefull = mypath + '\' + myfile
    wk.SaveCopyAs filefull
    'vbLf 换行
    MsgBox '备份成功!' & vbLf & '备份文件于' & mypath & '\' & & myfile & vbLf & '备份文件的全名为:' & filefull, vbOKOnly, '备份工作簿'
    Set wk = Nothing
End Sub
复制代码

【效果展示】

                                                        

                                                   

【使用保存对话框保存工作簿

【代码区域】

复制代码
Sub 使用保存对话框来保存文件()
    Dim wk As Workbook
    Dim fileinfo As String
    Set wk = Workbooks(1)
    wk.Activate
    fileinfo = Application.GetSaveAsFilename(exclefile, 'Excle 工作簿(*.xlsm),*.xlsx')
    If fileinfo = 'False' Then
    MsgBox '请输入工作簿名字', vbOKOnly, '保存工作簿'
    Exit Sub
    End If
    wk.SaveAs Filename:=fileinfo
    Set wk = Nothing
End Sub
复制代码

【效果展示】

【设置工作簿窗口大小】

【代码区域】

复制代码
Sub 设置工作簿窗口大小()
    Dim win As Window
    Dim windate As Long
    Dim winwidth As Long
    Dim winheight As Double
    Set win = Application.ActiveWindow
    win.Activate
    With win
        winstate = .WindowState
        winwidth = .Width
        winheight = .Height
        
        '设置窗口状态
        .WindowState = xlNormal
        .Width = 600
        .Height = 300
        MsgBox '设置窗口大小之前:' & vbLf & '窗口状态为:' & CStr(winstate) & vbLf & '窗口宽度为:' & CStr(winwidth) & vbLf & '窗口高度为:' & CStr(winheight) & vbLf & '设置窗口大小之后:' & vbLf & '窗口状态为:' & CStr(.WindowState) & vbLf & '窗口宽度为:' & CStr(.Width) & vbLf & '窗口高度为:' & CStr(.Height)
    End With
End Sub
复制代码

【效果展示】

 

【冻结窗口】

在Excle中可以直接使用冻结窗口冻结,但是这个不是很方便

下面我们使用宏来自定义冻结的行

【代码区域】

复制代码
Sub 冻结窗口()
    Dim win As Window
    Set win = Application.ActiveWindow
    With win
        .Split = True '冻结开关打开
        .SplitColumn = 4 '从第4列开始冻结
        .SplitRow = 3    '从第3行开始冻结
    End With
     win.FreezePanes = True '拆分冻结项打开
     MsgBox '冻结完成!', vbOKOnly, '冻结窗口'
     Set win = Nothing
End Sub
复制代码

【效果展示】

【更改工作簿名称】

【代码区域】

复制代码
Sub 更改工作簿名称()
    Dim filename As String
    filename = 'C:\OLIVER.xlsx'
    Name filename As 'C:\OLIVER_附件.xlsx'
    MsgBox ('工作簿名称修改完成'), vbOKOnly, '修改名称'
End Sub
复制代码

【效果展示】

【关闭工作簿】

【代码区域】

 Application.ActiveWorkbook.Close
 Application.Quit

    本站是提供个人知识管理的网络存储空间,所有内容均由用户发布,不代表本站观点。请注意甄别内容中的联系方式、诱导购买等信息,谨防诈骗。如发现有害或侵权内容,请点击一键举报。
    转藏 分享 献花(0

    0条评论

    发表

    请遵守用户 评论公约

    类似文章 更多