ExcelVBA>>ExcelVBA编程入门范例>>第三章 Workbook对象(fanjy) End If End Sub
示例03-20:设置工作簿密码(Password属性)
Sub UsePassword() Dim wb As Workbook
Set wb = Application.ActiveWorkbook wb.Password = InputBox(\请输入密码:\ wb.Close End Sub
示例说明:Password属性返回或设置工作簿密码,在打开工作簿时必须输入密码。本示例代码运行后,提示设置密码,然后关闭工作簿;再次打开工作簿时,要求输入密码。
示例03-21:返回工作簿用户状态信息(UserStatus属性)
Sub UsePassword() Dim Users As Variant Dim Row As Long
Users = ActiveWorkbook.UserStatus Row = 1
With Workbooks.Add.Sheets(1) .Cells(Row, 1) = \用户名\ .Cells(Row, 2) = \日期和时间\ .Cells(Row, 3) = \使用方式\
For Row = 1 To UBound(Users, 1) .Cells(Row + 1, 1) = Users(Row, 1) .Cells(Row + 1, 2) = Users(Row, 2) Select Case Users(Row, 3) Case 1
.Cells(Row + 1, 3).Value = \个人工作簿\ Case 2
.Cells(Row + 1, 3).Value = \共享工作簿\ End Select Next End With
Range(\End Sub
示例说明:示例代码运行后,将创建一个新工作簿并带有用户使用当前工作簿的信息,即用户名、打开的日期和时间及工作簿使用方式。
示例03-22:检查工作簿是否有密码保护(HasPassword属性)
Sub IsPassword()
If ActiveWorkbook.HasPassword = True Then
MsgBox \本工作簿有密码保护,请在管理员处获取密码.\
- 9 -http://fanjy.blog.excelhome.net ExcelVBA>>ExcelVBA编程入门范例>>第三章 Workbook对象(fanjy) Else
MsgBox \本工作簿无密码保护,您可以自由编辑.\ End If End Sub
示例03-23:决定列表边框是否可见(InactiveListBorderVisible属性)
Sub HideListBorders()
MsgBox \隐藏当前工作簿中所有非活动列表的边框.\ ActiveWorkbook.InactiveListBorderVisible = False End Sub
示例03-24:关闭工作簿
[示例03-24-01]
Sub CloseWorkbook1()
Msgbox “不保存所作的改变而关闭本工作簿” ActiveWorkbook.Close False
‘或ActiveWorkbook.Close SaveChanges:=False ‘或ActiveWorkbook.Saved=True End sub
[示例03-24-02]
Sub CloseWorkbook2()
Msgbox “保存所作的改变并关闭本工作簿” ActiveWorkbook.Close True End sub
[示例03-24-03]
Sub CloseWorkbook3()
Msgbox “关闭本工作簿。如果工作簿已发生变化,则弹出是否保存更改的对话框。” ActiveWorkbook.Close True End sub
[示例03-24-04] 关闭并保存所有工作簿 Sub CloseAllWorkbooks() Dim Book As Workbook
For Each Book In Workbooks
If Book.Name<>ThisWorkbook.Name Then Book.Close savechanges:=True End If Next Book
ThisWorkbook.Close savechanges:=True End Sub
[示例03-24-05] 关闭工作簿并将它彻底删除 Sub KillMe()
With ThisWorkbook .Saved = True
.ChangeFileAccess Mode:=xlReadOnly
- 10 -
http://fanjy.blog.excelhome.net ExcelVBA>>ExcelVBA编程入门范例>>第三章 Workbook对象(fanjy) Kill .FullName .Close False End With End Sub
[示例03-24-06]关闭所有工作簿,若工作簿已改变则弹出是否保存变化的对话框 Sub closeAllWorkbook()
MsgBox \关闭当前所打开的所有工作簿\ Workbooks.Close End Sub
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
<其它一些有关操作工作簿的示例> 示例03-25:创建新的工作簿
Sub testNewWorkbook()
MsgBox \创建一个带有10个工作表的新工作簿\Dim wb as Workbook
Set wb = NewWorkbook(10) End Sub
‘- - - - - - - - - - - - - - - - - - - - - - -
Function NewWorkbook(wsCount As Integer) As Workbook
'创建带有由变量wsCount提定数量工作表的工作簿,工作表数在1至255之间 Dim OriginalWorksheetCount As Long Set NewWorkbook = Nothing
If wsCount < 1 Or wsCount > 255 Then Exit Function
OriginalWorksheetCount = Application.SheetsInNewWorkbook Application.SheetsInNewWorkbook = wsCount Set NewWorkbook = Workbooks.Add
Application.SheetsInNewWorkbook = OriginalWorksheetCount End Function
示例说明:自定义函数NewWorkbook可以创建最多带有255个工作表的工作簿。本测试示例创建一个带有10个工作表的新工作簿。
示例03-26:判断工作簿是否存在
Sub testFileExists()
MsgBox \如果文件不存在则用信息框说明,否则打开该文件.\ If Not FileExists(\文件夹\\子文件夹\\文件.xls\ MsgBox \这个工作簿不存在!\ Else
Workbooks.Open \文件夹\\子文件夹\\文件.xls\ End If End Sub
‘- - - - - - - - - - - - - - - - - - - - - - -
- 11 -
http://fanjy.blog.excelhome.net ExcelVBA>>ExcelVBA编程入门范例>>第三章 Workbook对象(fanjy) Function FileExists(FullFileName As String) As Boolean '如果工作簿存在,则返回True
FileExists = Len(Dir(FullFileName)) > 0 End Function
示例说明:本示例使用自定义函数FileExists判断工作簿是否存在,若该工作簿已存在,则打开它。代码中,“C:\\文件夹\\子文件夹\\文件.xls”代表工作簿所在的文件夹名、子文件夹名和工作簿文件名。
示例03-27:判断工作簿是否已打开
[示例03-27-01]
Sub testWorkbookOpen()
MsgBox \如果工作簿未打开,则打开该工作簿.\ If Not WorkbookOpen(\工作簿名.xls\ Workbooks.Open \工作簿名.xls\ End If End Sub
‘- - - - - - - - - - - - - - - - - - - - - - -
Function WorkbookOpen(WorkBookName As String) As Boolean '如果该工作簿已打开则返回真 WorkbookOpen = False
On Error GoTo WorkBookNotOpen
If Len(Application.Workbooks(WorkBookName).Name) > 0 Then WorkbookOpen = True MsgBox \该工作簿已打开\ Exit Function End If
WorkBookNotOpen: End Function
示例说明:本示例中的函数WorkbookOpen用来判断工作簿是否打开。代码中,“工作簿名.xls”代表所要打开的工作簿名称。 [示例03-27-02]
Sub testWookbookIFOpen() Dim wb As String Dim bwb As Boolean
wb = \要判断的工作簿名称>\ bwb = WorkbookIsOpen(wb) If bwb = True Then
MsgBox \工作簿\已打开.\ Else
MsgBox \工作簿\未打开.\ End If End Sub
- 12 -
http://fanjy.blog.excelhome.net ExcelVBA>>ExcelVBA编程入门范例>>第三章 Workbook对象(fanjy) ‘- - - - - - - - - - - - - - - - - - - - - - -
Private Function WorkbookIsOpen(wbname) As Boolean Dim x As Workbook On Error Resume Next
Set x = Workbooks(wbname) If Err = 0 Then
WorkbookIsOpen = True Else
WorkbookIsOpen = False End If
End Function
示例03-28:备份工作簿
[示例03-28-01] 用与活动工作簿相同的名字但后缀名为.bak备份工作簿 Sub SaveWorkbookBackup()
Dim awb As Workbook, BackupFileName As String, i As Integer, OK As Boolean If TypeName(ActiveWorkbook) = \ Set awb = ActiveWorkbook If awb.Path = \
Application.Dialogs(xlDialogSaveAs).Show Else
BackupFileName = awb.FullName i = 0
While InStr(i + 1, BackupFileName, \ i = InStr(i + 1, BackupFileName, \ Wend
If i > 0 Then BackupFileName = Left(BackupFileName, i - 1) BackupFileName = BackupFileName & \ OK = False
On Error GoTo NotAbleToSave With awb
Application.StatusBar = \正在保存工作簿...\ .Save
Application.StatusBar = \正在备份工作簿...\ .SaveCopyAs BackupFileName OK = True End With End If
NotAbleToSave:
Set awb = Nothing
Application.StatusBar = False If Not OK Then
MsgBox \备份工作簿未保存!\ End If
- 13 -
http://fanjy.blog.excelhome.net