ExcelVBA编程实例（150例） - 图文 

示例03-06：保存工作簿(SaveAs方法) [示例03-06-01]

Sub SaveWorkbook1()

MsgBox \将工作簿以指定名保存在默认文件夹中.\ ActiveWorkbook.SaveAs \工作簿名>.xls\End Sub

示例说明：SaveAs方法相当于“另存为??”命令，以指定名称保存工作簿。该方法有12个参数，均为可选参数。如果未指定保存的路径，那么将在默认文件夹中保存该工作簿。如果文件夹中该工作簿名已存在，则提示是否替换原工作簿。

[示例03-06-02]

Sub SaveWorkbook2()

Dim oldName As String, newName As String Dim folderName As String, fname As String oldName = ActiveWorkbook.Name newName = \

MsgBox \将<\以<\的名称保存\ folderName = Application.DefaultFilePath fname = folderName & \ ActiveWorkbook.SaveAs fname End Sub 示例说明：本示例将当前工作簿以一个新名(即new加原名)保存在默认文件夹中。 [示例03-06-03] Sub CreateBak1()

MsgBox \保存工作簿并建立备份工作簿\

ActiveWorkbook.SaveAs CreateBackup:=True End Sub

示例说明：本示例将在当前文件夹中建立工作簿的备份。 [示例03-06-04] Sub CreateBak2()

MsgBox \保存工作簿时,若已建立了备份,则将出现包含True的信息框,否则出现False.\

MsgBox ActiveWorkbook.CreateBackup End Sub

示例03-07：取得当前打开的工作簿数(Count属性) Sub WorkbookNum()

MsgBox \当前已打开的工作簿数为:\End Sub

示例03-08：激活工作簿(Activate方法) [示例03-08-01]

Sub ActivateWorkbook1()

Workbooks(\工作簿名>\

31

End Sub

示例说明：Activate方法激活一个工作簿，使该工作簿为当前工作簿。 [示例03-08-02]

Sub ActivateWorkbook2() 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(\第 \个工作簿被激活，还要继续吗?\ If b = vbNo Then Exit Sub

If i = n Then MsgBox \最后一个工作簿已被激活.\ Next i End Sub

示例03-09：保护工作簿(Protect方法) Sub ProtectWorkbook()

MsgBox \保护工作簿结构,密码为123\

ActiveWorkbook.Protect Password:=\ MsgBox \保护工作簿窗口,密码为123\

ActiveWorkbook.Protect Password:=\ MsgBox \保护工作簿结构和窗口,密码为123\

ActiveWorkbook.Protect Password:=\rue

End Sub

示例说明：使用Protect方法来保护工作簿，带有三个可选参数，参数Password指明保护工作簿密码，要解除工作簿保护应输入此密码；参数Structure设置为True则保护工作簿结构，此时不能对工作簿中的工作表进行插入、复制、删除等操作；参数Windows设置为True则保护工作簿窗口，此时该工作簿右上角的最小化、最大化和关闭按钮消失。

示例03-10：解除工作簿保护(UnProtect方法) Sub UnprotectWorkbook() MsgBox \取消工作簿保护\

ActiveWorkbook.Unprotect \End Sub

示例03-11：工作簿的一些通用属性示例 Sub testGeneralWorkbookInfo()

MsgBox \本工作簿的名称为\

MsgBox \本工作簿带完整路径的名称为\ MsgBox \本工作簿对象的代码名为\ MsgBox \本工作簿的路径为\

32

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