工作簿基本操作应用实例

上一篇 / 下一篇 2006-10-24 14:49:57 / 个人分类：Excelvba

查看( 926 ) / 评论( 4 )

今天向Fanjy(blog:http://fanjy.blog.excelhome.net/user1/fanjy/index.html)学习了工作簿常用方法和属性，现总结如下：

一、工作簿方法
1、workbooks.add 表示增加一个工作簿，可以将其赋值给一个工作簿对象变量，以便对其进行操作。如：
dim Wb as workbook
set wb=workbooks.add
2、workbooks.open filename:="工作簿路径及文件名" 表示打开指定的文件，在实际运用中可以参考帮助理解打开工作簿的其他参数
3、workbooks.opentext filename:="文本文件"表示载入一个文本文件并将其作为包含单个工作表的工作簿进行分列处理，然后在此工作表中放入经过分列处理的文本文件数据。
4、workbooks.close表示关闭所有已打开的工作簿
其中savechanges:=true表示在关闭工作簿时，保存原来的更改，否则不保存更改
5、workbooks.opendatabase 返回一个workbook
类似从数据库中导数据到工作簿中，如：
Sub test()
Workbooks.OpenDatabase Filename:="F:\vba程序集\1.mdb"
End Sub
7、workbooks(2).activate激活工作簿
9、workbooks.protect/unprotect保护或者解除工作簿
10、workbooks.save/saveas保存工作簿
二、工作簿属性
1、Activeworkbook.name 返回活动工作簿的名称
2、Activeworkbook.path 返回活动工作簿的路径，不含工作簿名称
3、activeworkbook.fullname 返回活动工作簿的名称，包含路径
4、activeworkbook.password "123" 设置活动工作簿的密码（在打开指定的工作簿时，提示输入密码方可打开）
5、activeworkbook.readonly
6、activeworkbook.builtindocumentproperties设置活动工作簿属性
三、具体实例
1、activeworkbook.haspassword判断活动工作簿是否含有密码
2、ActiveWorkbook.EnableAutoRecover检查工作簿的自动恢复功能
3、workbooks.names指定工作簿名称
Sub WbNames()
'批量指定工作簿名称
For i = 1 To 10
ActiveWorkbook.Names.Add Name:="姓名" & i, RefersTo:=Worksheets("Sheet2").Range("a1:a" & i + 5)
Next i
End Sub

Sub WbNames1()
'返回自定义名称，类似excel中的粘贴名称
Dim t As Name
For Each t In ActiveWorkbook.Names
i = i + 1
Cells(i, 1) = t.Name
Cells(i, 2) = t
Next t
End Sub
4、删除指定的自定义格式
Sub DeleteFormat()
'删除数字格式
ActiveWorkbook.DeleteNumberFormat ("000-00-00")
End Sub
5、工作簿的一些通用属性
Sub WbGeneralProperties()
Dim msg As String
msg = "返回活动工作簿的名称：" & ActiveWorkbook.Name
msg = msg & vbCrLf & vbCrLf & "活动工作簿带路径名称为：" & ActiveWorkbook.FullName
msg = msg & vbCrLf & vbCrLf & "活动工作簿的路径为：" & ActiveWorkbook.Path
msg = msg & vbCrLf & vbCrLf & "活动工作簿代码名称为：" & ActiveWorkbook.CodeName
MsgBox msg
If ActiveWorkbook.ReadOnly Then
   MsgBox "活动工作簿以只读方式打开"
Else
   MsgBox "活动工作簿为可读写"
End If
If ActiveWorkbook.Saved Then
   MsgBox "活动工作簿已保存"
Else
   MsgBox "活动工作簿未保存", vbOKOnly, "温馨提示"
End If
End Sub
6、保护工作簿
Sub WbProtect()
MsgBox "测试工作簿保护"
ActiveWorkbook.Protect Password:="888", structure:=True, Windows:=False
End Sub
Sub WbUnProtect()
ActiveWorkbook.Unprotect Password:="888"
End Sub
7、测试工作簿中是否包含指定的工作表
Sub WsBoolean()
'测试工作簿中是否包含指定的工作表
Dim Ws As String
Dim t As Worksheet
On Error Resume Next
Ws = InputBox("请输入要查询的工作表：", "查询工作表")
Set t = Worksheets(Ws)
If Err <> 0 Then
   MsgBox "不存在该工作表"
Else
   MsgBox "存在该工作表"
End If
End Sub
8、打开工作簿
Sub WbOpen()
Dim Wb As Workbook
On Error Resume Next
Workbooks.Open Filename:="F:\vba程序集\4.XLS"
MsgBox "打开工作簿的名称为：" & ActiveWorkbook.FullName
End Sub
Sub test()
Workbooks.OpenDatabase Filename:="F:\vba程序集\1.mdb"
End Sub
9、对未打开的工作簿重命名
Sub ReNameOutFile()
'该方法不但可以对未打开的文件重命名，还可以移动文件到别的磁盘

Name "d:\1.txt" As "f:\测试.txt"
End Sub
10、返回工作簿用户状态信息
Sub UseInformation()
Dim UserIn As Variant
'返回用户状态信息，userstatus返回一个二维数组
'数组第二维的第一个元素为用户名，第二个元素是用户打开工作簿的日期和时间，第三个元素是一个表示清单类型的数字（1 表示独占，2 表示共享）。Variant 类型，只读。

UserIn = ActiveWorkbook.UserStatus
With ActiveWorkbook.Worksheets("Sheet2")
   .Cells(1, 1) = "姓名"
   .Cells(1, 2) = "日期和时间"
   .Cells(1, 3) = "使用方式"
   For i = 1 To UBound(UserIn, 1)
      .Cells(i + 1, 1) = UserIn(i, 1)
      .Cells(i + 1, 2) = UserIn(i, 2)
      Select Case UserIn(i, 3)
         Case 1
             .Cells(i + 1, 3) = "独占工作簿"
         Case 2
             .Cells(i + 1, 3) = "共享工作簿"
      End Select
    Next i
    .Range("a:c").Columns.AutoFit
End With
End Sub

11、返回工作簿的内置属性
Sub TestDocumentProterties()
'BuiltinDocumentProperties属性返回一个DocumentPerties集合
'该集合代表指定工作簿的所有内置属性
Dim t As Object
For Each t In ActiveWorkbook.BuiltinDocumentProperties
   i = i + 1
   Cells(i, 1) = t.Name
Next t
End Sub
Sub TestDocumentProterties1()
'测试文档最后保存的时间
Dim t As String
t = ActiveWorkbook.BuiltinDocumentProperties("Last save time")
If t = "" Then
   MsgBox "该工作簿未保存"
Else
   MsgBox "该工作簿已于" & t & "保存", vbOKOnly
End If
End Sub
Sub listWorkbookProperties()
On Error Resume Next
'在名为"工作簿属性"的工作表中添加信息,若该工作表不存在,则新建一个工作表
Worksheets("工作簿属性").Activate
If Err.Number <> 0 Then
    Worksheets.Add after:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = "工作簿属性"
Else
    ActiveSheet.Clear
End If
On Error GoTo 0
ListProperties
End Sub
Sub ListProperties()
Dim i As Long
Cells(1, 1) = "名称"
Cells(1, 2) = "类型"
Cells(1, 3) = "值"
Range("A1:C1").Font.Bold = True
With ActiveWorkbook
    For i = 1 To .BuiltinDocumentProperties.Count
      With .BuiltinDocumentProperties(i)
        Cells(i + 1, 1) = .Name
        Select Case .Type
          Case msoPropertyTypeBoolean
            Cells(i + 1, 2) = "Boolean"
          Case msoPropertyTypeDate
            Cells(i + 1, 2) = "Date"
          Case msoPropertyTypeFloat
            Cells(i + 1, 2) = "Float"
          Case msoPropertyTypeNumber
            Cells(i + 1, 2) = "Number"
          Case msoPropertyTypeString
            Cells(i + 1, 2) = "string"
        End Select
        On Error Resume Next
        Cells(i + 1, 3) = .Value
        On Error GoTo 0
      End With
    Next i
End With
Range("A:C").Columns.AutoFit
End Sub
12、关闭工作簿
Sub CloseWb1()
'不保存所做的更改，关闭工作簿 1、activeworkbook.close savechanges:=false
'2、activeworkbook.saved=true 表示如果指定的工作簿从上次至今未发生过更改，则该值为true
Application.DisplayAlerts = False
'ActiveWorkbook.Close savechanges:=False
ActiveWorkbook.Saved = True
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub
Sub CloseWb2()
'保存所做的更改关闭工作簿
MsgBox "保存所做的更改并关闭工作簿"
ActiveWorkbook.Close savechanges:=True
End Sub

Sub CloseWb3()
'关闭本工作簿，如果本工作簿已改变，则提示是否保存该工作簿
ActiveWorkbook.Close

End Sub
Sub CloseWb4()
'关闭并保存所有打开的工作簿
Dim FlagWb As Workbook
Application.DisplayAlerts = False
For Each FlagWb In Workbooks
    If FlagWb.Name <> ActiveWorkbook.Name Then
        FlagWb.Close savechanges:=True
    End If
Next FlagWb
ActiveWorkbook.Close savechanges:=True
Application.DisplayAlerts = True

End Sub
Sub DeleteWb()
'删除磁盘中指定的文件
Kill pathname:="F:\vba程序集\新建文本文档.txt"

End Sub
Sub CloseWb5()
'关闭所有打开的工作簿，并提示是否保存工作簿
Workbooks.Close
End Sub

13、激活工作簿
Sub WbActivate()
Dim n As Long, i As Long
Dim b As String
MsgBox "依次激活已经打开的工作簿"
n = Workbooks.Count
For i = 1 To n
    Workbooks(i).Activate
    b = MsgBox("第 " & i & "个工作簿被激活，还要继续吗?", vbYesNo)
    If b = vbNo Then Exit Sub
    If i = n Then MsgBox "最后一个工作簿已被激活."
Next i

End Sub
Sub WbCount()
MsgBox "当前已打开工作簿的数量为：" & Workbooks.Count
End Sub
14、检查工作簿是否包含密码
Sub HasPassWord()
MsgBox "检查本工作簿是否有密码保护"
If ActiveWorkbook.HasPassWord = True Then
   MsgBox "本工作簿有密码保护"
Else
   MsgBox "本工作簿无密码保护"
End If

End Sub

论坛模式推荐收藏分享给好友管理

TAG: Excelvba

sky62118 发布于2006-10-24 19:44:18: 感谢版主一同分享！
经典，收下！
*o}Qx1Xr,s(|感谢版主一同分享！

west_wolf 发布于2006-10-25 08:08:10: 其实应该感谢fanjy，是他的博客给了我启发，他的博客办的相当好了，我已经把他的博客看作我vba的培训基地了了

xcd 发布于2006-10-25 08:33:10: 谢谢west_wolf 分亨
真精彩，谢谢west_wolf 分亨，收下参研了。期待着下一期的发言。:victory: :victory:
.U9Q7NM)\sIg({1gwww.officefans.net
(i"fYq;E9lj/\[ 本帖最后由 xcd 于 2006-10-25 08:34 编辑 ]