发布时间 : 星期五 文章ExcelVBA编程实例（150例） - 图文更新完毕开始阅读0a8ac20876c66137ee061985
If ActiveWorkbook.ReadOnly Then
MsgBox \本工作簿已经是以只读方式打开\ Else
MsgBox \本工作簿可读写.\ End If
If ActiveWorkbook.Saved Then MsgBox \本工作簿已保存.\ Else
MsgBox \本工作簿需要保存.\ End If End Sub
示例03-12：访问工作簿的内置属性(BuiltinDocumentProperties属性) [示例03-12-01]
Sub ShowWorkbookProperties() Dim SaveTime As String On Error Resume Next
SaveTime = ActiveWorkbook.BuiltinDocumentProperties(\\
If SaveTime = \
MsgBox ActiveWorkbook.Name & \工作簿未保存.\ Else
MsgBox \本工作簿已于\保存\ End If End Sub
示例说明：在Excel中选择菜单“文件——属性”命令时将会显示一个“属性”对话框，该对话框中包含了当前工作簿的有关信息，可以在VBA中使用BuiltinDocumentProperties属性访问工作簿的属性。上述示例代码将显示当前工作簿保存时的日期和时间。 [示例03-12-02]
Sub listWorkbookProperties() On Error Resume Next
'在名为\工作簿属性\的工作表中添加信息,若该工作表不存在,则新建一个工作表
Worksheets(\工作簿属性\ 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
33
‘- - - - - - - - - - - - - - - - - - - - - - - Sub ListProperties() Dim i As Long
Cells(1, 1) = \名称\ Cells(1, 2) = \类型\ Cells(1, 3) = \值\
Range(\ 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) = \ Case msoPropertyTypeDate Cells(i + 1, 2) = \ Case msoPropertyTypeFloat Cells(i + 1, 2) = \ Case msoPropertyTypeNumber Cells(i + 1, 2) = \ Case msoPropertyTypeString Cells(i + 1, 2) = \ End Select
On Error Resume Next
Cells(i + 1, 3) = .Value On Error GoTo 0 End With Next i End With
Range(\End Sub
示例说明：本示例代码在“工作簿属性”工作表中列出了当前工作簿中的所有内置属性。
示例03-13：测试工作簿中是否包含指定工作表(Sheets属性) Sub testSheetExists()
MsgBox \测试工作簿中是否存在指定名称的工作表\ Dim b As Boolean
b = SheetExists(\指定的工作表名>\ If b = True Then
MsgBox \该工作表存在于工作簿中.\ Else
MsgBox \工作簿中没有这个工作表.\ End If
34
End Sub
‘- - - - - - - - - - - - - - - - - - - - - - - Private Function SheetExists(sname) As Boolean Dim x As Object
On Error Resume Next
Set x = ActiveWorkbook.Sheets(sname) If Err = 0 Then
SheetExists = True Else
SheetExists = False End If
End Function
示例03-14：对未打开的工作簿进行重命名(Name方法) Sub rename()
Name \工作簿路径>\\<旧名称>.xls\工作簿路径>\\<新名称>.xls\End Sub
示例说明：代码中<>中的内容为需要重命名的工作簿所在路径及新旧名称。该方法只是对未打开的文件进行重命名，如果该文件已经打开，使用该方法会提示错误。
示例03-15：设置数字精度(PrecisionAsDisplayed属性) Sub SetPrecision() Dim pValue
MsgBox \在当前单元格中输入1/3，并将结果算至小数点后两位\ ActiveCell.Value = 1 / 3
ActiveCell.NumberFormatLocal = \ pValue = ActiveCell.Value * 3
MsgBox \当前单元格中的数字乘以3等于：\
MsgBox \然后,将数值分类设置为[数值],即单元格中显示的精度\ ActiveWorkbook.PrecisionAsDisplayed = True pValue = ActiveCell.Value * 3
MsgBox \此时,当前单元格中的数字乘以3等于：\而不是1\ ActiveWorkbook.PrecisionAsDisplayed = False End Sub
示例说明：PrecisionAsDisplayed属性的值设置为True，则表明采用单元格中所显示的数值进行计算。
示例03-16：删除自定义数字格式(DeleteNumberFormat方法) Sub DeleteNumberFormat()
MsgBox \从当前工作簿中删除000-00-0000的数字格式\ ActiveWorkbook.DeleteNumberFormat (\End Sub
示例说明：DeleteNumberFormat方法将从指定的工作簿中删除自定义的数字格
35
式。
示例03-17：控制工作簿中图形显示(DisplatyDrawingObjects属性) Sub testDraw()
MsgBox \隐藏当前工作簿中的所有图形\
ActiveWorkbook.DisplayDrawingObjects = xlHide MsgBox \仅显示当前工作簿中所有图形的占位符\
ActiveWorkbook.DisplayDrawingObjects = xlPlaceholders MsgBox \显示当前工作簿中的所有图形\
ActiveWorkbook.DisplayDrawingObjects = xlDisplayShapes End Sub
示例说明：本属性作用的对象包括图表和形状。在应用本示例前，应保证工作簿中有图表或形状，以察看效果。
示例03-18：指定名称(Names属性) Sub testNames()
MsgBox \将当前工作簿中工作表Sheet1内单元格A1命名为myName.\
ActiveWorkbook.Names.Add Name:=\1\
End Sub
示例说明：对于Workbook对象而言，Names属性返回的集合代表工作簿中的所有名称。
示例03-19：检查工作簿的自动恢复功能(EnableAutoRecover属性) Sub UseAutoRecover()
'检查是否工作簿自动恢复功能开启,如果没有则开启该功能 If ActiveWorkbook.EnableAutoRecover = False Then ActiveWorkbook.EnableAutoRecover = True MsgBox \刚开启自动恢复功能.\ Else
MsgBox \自动恢复功能已开启.\ 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属性返回或设置工作簿密码，在打开工作簿时必须输入密码。本示例代码运行后，提示设置密码，然后关闭工作簿；再次打开工作簿时，要求输入密码。
36