VBA Application,window,worksheet基本操作方法(三)
工作簿(Workbook)基本操作应用示例
Workbook对象代表工作簿，而Workbooks集合则包含了当前所有的工作簿。下面对Workbook对象的重要的方法和属性以及其它一些可能涉及到的方法和属性进行示例介绍，同时，后面的示例也深入介绍了一些工作簿对象操作的方法和技巧。
--------------------------------------------------------------------------------
示例03-01：创建工作簿(Add方法)
[示例03-01-01]
Sub CreateNewWorkbook1()
MsgBox "将创建一个新工作簿."
Workbooks.Add
End Sub
[示例03-01-02]
Sub CreateNewWorkbook2()
Dim wb As Workbook
Dim ws As Worksheet
Dim i As Long
MsgBox "将创建一个新工作簿,并预设工作表格式."
Set wb = Workbooks.Add
Set ws = wb.Sheets(1)
ws.Name = "产品汇总表"
ws.Cells(1, 1) = "序号"
ws.Cells(1, 2) = "产品名称"
ws.Cells(1, 3) = "产品数量"
For i = 2 To 10
ws.Cells(i, 1) = i - 1
Next i
End Sub
--------------------------------------------------------------------------------
示例03-02：添加并保存新工作簿
Sub AddSaveAsNewWorkbook()
Dim Wk As Workbook
Set Wk = Workbooks.Add
Application.DisplayAlerts = False
Wk.SaveAs Filename:="D:/SalesData.xls"
End Sub
示例说明：本示例使用了Add方法和SaveAs方法，添加一个新工作簿并将该工作簿以文件名SalesData.xls保存在D盘中。其中，语句Application.DisplayAlerts = False表示禁止弹出警告对话框。
--------------------------------------------------------------------------------
示例03-03：打开工作簿(Open方法)
[示例03-03-01]
Sub openWorkbook1()
Workbooks.Open "<需打开文件的路径>\<文件名>"
End Sub
示例说明：代码中的<>里的内容需用所需打开的文件的路径及文件名代替。Open方法共有15个参数，其中参数FileName为必需的参数，其余参数可选。
[示例03-03-02]
Sub openWorkbook2()
Dim fname As String
MsgBox "将D盘中的<测试.xls>工作簿以只读方式打开"
fname = "D:\测试.xls"
Workbooks.Open Filename:=fname, ReadOnly:=True
End Sub
--------------------------------------------------------------------------------
示例03-04：将文本文件导入工作簿中(OpenText方法)
Sub TextToWorkbook()
'本示例打开某文本文件并将制表符作为分隔符对此文件进行分列处理转换成为工作表
Workbooks.OpenText Filename:="<文本文件所在的路径>/<文本文件名>", _
DataType:=xlDelimited, Tab:=True
End Sub
示例说明：代码中的<>里的内容需用所载入的文本文件所在路径及文件名代替。OpenText方法的作用是导入一个文本文件，并将其作为包含单个工作表的工作簿进行分列处理，然后在此工作表中放入经过分列处理的文本文件数据。该方法共有18个参数，其中参数FileName为必需的参数，其余参数可选。
--------------------------------------------------------------------------------
示例03-05：保存工作簿(Save方法)
[示例03-05-01]
Sub SaveWorkbook()
MsgBox "保存当前工作簿."
ActiveWorkbook.Save
End Sub
[示例03-05-02]
Sub SaveAllWorkbook1()
Dim wb As Workbook
MsgBox "保存所有打开的工作簿后退出Excel."
For Each wb In Application.Workbooks
wb.Save
Next wb
Application.Quit
End Sub
[示例03-05-03]
Sub SaveAllWorkbook2()
Dim wb As Workbook
For Each wb In Workbooks
If wb.Path <> "" Then wb.Save
Next wb
End Sub
示例说明：本示例保存原来已存在且已打开的工作簿。
--------------------------------------------------------------------------------
示例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 = "new" & oldName
MsgBox "将<" & oldName & ">以<" & newName & ">的名称保存"
folderName = Application.DefaultFilePath
fname = folderName & "\" & newName
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 "当前已打开的工作簿数为:" & Chr(10) & Workbooks.Count
End Sub
--------------------------------------------------------------------------------
[NextPage] 示例03-08：激活工作簿(Activate方法)
[示例03-08-01]
Sub ActivateWorkbook1()
Workbooks("<工作簿名>").Activate
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("第 " & i & "个工作簿被激活，还要继续吗?", vbYesNo)
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:="123", Structure:=True
MsgBox "保护工作簿窗口,密码为123"
ActiveWorkbook.Protect Password:="123", Windows:=True
MsgBox "保护工作簿结构和窗口,密码为123"
ActiveWorkbook.Protect Password:="123", Structure:=True, Windows:=True
End Sub
示例说明：使用Protect方法来保护工作簿，带有三个可选参数，参数Password指明保护工作簿密码，要解除工作簿保护应输入此密码；参数Structure设置为True则保护工作簿结构，此时不能对工作簿中的工作表进行插入、复制、删除等操作；参数Windows设置为True则保护工作簿窗口，此时该工作簿右上角的最小化、最大化和关闭按钮消失。
--------------------------------------------------------------------------------
示例03-10：解除工作簿保护(UnProtect方法)
Sub UnprotectWorkbook()
MsgBox "取消工作簿保护"
ActiveWorkbook.Unprotect "123"
End Sub
--------------------------------------------------------------------------------
示例03-11：工作簿的一些通用属性示例
Sub testGeneralWorkbookInfo()
MsgBox "本工作簿的名称为" & ActiveWorkbook.Name
MsgBox "本工作簿带完整路径的名称为" & ActiveWorkbook.FullName
MsgBox "本工作簿对象的代码名为" & ActiveWorkbook.CodeName
MsgBox "本工作簿的路径为" & ActiveWorkbook.Path
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("Last Save Time").Value
If SaveTime = "" Then
MsgBox ActiveWorkbook.Name & "工作簿未保存."
Else
MsgBox "本工作簿已于" & SaveTime & "保存", , ActiveWorkbook.Name
End If
End Sub
示例说明：在Excel中选择菜单“文件——属性”命令时将会显示一个“属性”对话框，该对话框中包含了当前工作簿的有关信息，可以在VBA中使用BuiltinDocumentProperties属性访问工作簿的属性。上述示例代码将显示当前工作簿保存时的日期和时间。
[示例03-12-02]
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
示例说明：本示例代码在“工作簿属性”工作表中列出了当前工作簿中的所有内置属性。
--------------------------------------------------------------------------------
示例03-13：测试工作簿中是否包含指定工作表(Sheets属性)
Sub testSheetExists()
MsgBox "测试工作簿中是否存在指定名称的工作表"
Dim b As Boolean
b = SheetExists("<指定的工作表名>")
If b = True Then
MsgBox "该工作表存在于工作簿中."
Else
MsgBox "工作簿中没有这个工作表."
End If
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" As "<工作簿路径>\<新名称>.xls"
End Sub
示例说明：代码中<>中的内容为需要重命名的工作簿所在路径及新旧名称。该方法只是对未打开的文件进行重命名，如果该文件已经打开，使用该方法会提示错误。
--------------------------------------------------------------------------------
[NextPage] 示例03-15：设置数字精度(PrecisionAsDisplayed属性)
Sub SetPrecision()
Dim pValue
MsgBox "在当前单元格中输入1/3，并将结果算至小数点后两位"
ActiveCell.Value = 1 / 3
ActiveCell.NumberFormatLocal = "0.00"
pValue = ActiveCell.Value * 3
MsgBox "当前单元格中的数字乘以3等于：" & pValue
MsgBox "然后,将数值分类设置为[数值],即单元格中显示的精度"
ActiveWorkbook.PrecisionAsDisplayed = True
pValue = ActiveCell.Value * 3
MsgBox "此时,当前单元格中的数字乘以3等于：" & pValue & "而不是1"
ActiveWorkbook.PrecisionAsDisplayed = False
End Sub
示例说明：PrecisionAsDisplayed属性的值设置为True，则表明采用单元格中所显示的数值进行计算。
--------------------------------------------------------------------------------
示例03-16：删除自定义数字格式(DeleteNumberFormat方法)
Sub DeleteNumberFormat()
MsgBox "从当前工作簿中删除000-00-0000的数字格式"
ActiveWorkbook.DeleteNumberFormat ("000-00-0000")
End Sub
示例说明：DeleteNumberFormat方法将从指定的工作簿中删除自定义的数字格式。
--------------------------------------------------------------------------------
示例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:="myName", RefersToR1C1:="=Sheet1!R1C1"
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属性返回或设置工作簿密码，在打开工作簿时必须输入密码。本示例代码运行后，提示设置密码，然后关闭工作簿；再次打开工作簿时，要求输入密码。
--------------------------------------------------------------------------------
示例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("A:C").Columns.AutoFit
End Sub
示例说明：示例代码运行后，将创建一个新工作簿并带有用户使用当前工作簿的信息，即用户名、打开的日期和时间及工作簿使用方式。
--------------------------------------------------------------------------------
[NextPage] 示例03-22：检查工作簿是否有密码保护(HasPassword属性)
Sub IsPassword()
If ActiveWorkbook.HasPassword = True Then
MsgBox "本工作簿有密码保护,请在管理员处获取密码."
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
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("C:\文件夹\子文件夹\文件.xls") Then
MsgBox "这个工作簿不存在!"
Else
Workbooks.Open "C:\文件夹\子文件夹\文件.xls"
End If
End Sub
‘- - - - - - - - - - - - - - - - - - - - - - -
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") Then
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 "工作簿" & wb & "已打开."
Else
MsgBox "工作簿" & wb & "未打开."
End If
End Sub
‘- - - - - - - - - - - - - - - - - - - - - - -
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) = "Nothing" Then Exit Sub
Set awb = ActiveWorkbook
If awb.Path = "" Then
Application.Dialogs(xlDialogSaveAs).Show
Else
BackupFileName = awb.FullName
i = 0
While InStr(i + 1, BackupFileName, ".") > 0
i = InStr(i + 1, BackupFileName, ".")
Wend
If i > 0 Then BackupFileName = Left(BackupFileName, i - 1)
BackupFileName = BackupFileName & ".bak"
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 "备份工作簿未保存!", vbExclamation, ThisWorkbook.Name
End If
End Sub
示例说明：在当前工作簿中运行本示例代码后，将以与工作簿相同的名称但后缀名为.bak备份工作簿，且该备份与当前工作簿在同一文件夹中。其中，使用了工作簿的FullName属性和SaveCopyAs方法。
[示例03-28-02] 保存当前工作簿的副本到其它位置备份工作簿
Sub SaveWorkbookBackupToFloppyD()
Dim awb As Workbook, BackupFileName As String, i As Integer, OK As Boolean
If TypeName(ActiveWorkbook) = "Nothing" Then Exit Sub
Set awb = ActiveWorkbook
If awb.Path = "" Then
Application.Dialogs(xlDialogSaveAs).Show
Else
BackupFileName = awb.Name
OK = False
On Error GoTo NotAbleToSave
If Dir("D:\" & BackupFileName) <> "" Then
Kill "D:\" & BackupFileName
End If
With awb
Application.StatusBar = "正在保存工作簿..."
.Save
Application.StatusBar = "正在备份工作簿..."
.SaveCopyAs "D:\" & BackupFileName
OK = True
End With
End If
NotAbleToSave:
Set awb = Nothing
Application.StatusBar = False
If Not OK Then
MsgBox "备份工作簿未保存!", vbExclamation, ThisWorkbook.Name
End If
End Sub
示例说明：本程序将把当前工作簿进行复制并以与当前工作簿相同的名称保存在D盘中。其中，使用了Kill方法来删除已存在的工作簿。
--------------------------------------------------------------------------------
示例03-29：从已关闭的工作簿中取值
[示例03-29-01]
Sub testGetValuesFromClosedWorkbook()
GetValuesFromAClosedWorkbook "C:", "Book1.xls", "Sheet1", "A1:G20"
End Sub
‘- - - - - - - - - - - - - - - - - - - - - - -
Sub GetValuesFromAClosedWorkbook(fPath As String, _
fName As String, sName, cellRange As String)
With ActiveSheet.Range(cellRange)
.FormulaArray = "='" & fPath & "\[" & fName & "]" _
& sName & "'!" & cellRange
.Value = .Value
End With
End Sub
示例说明：本示例包含一个子过程GetValuesFromAClosedWorkbook，用来从已关闭的工作簿中获取数据，主过程testGetValuesFromClosedWorkbook用来传递参数。本示例表示从C盘根目录下的Book1.xls工作簿的工作表Sheet1中的A1:G20单元格区域内获取数据，并将其复制到当前工作表相应单元格区域中。
[示例03-29-02]
Sub ReadDataFromAllWorkbooksInFolder()
Dim FolderName As String, wbName As String, r As Long, cValue As Variant
Dim wbList() As String, wbCount As Integer, i As Integer
FolderName = "C:\文件夹名"
'创建文件夹中工作簿列表
wbCount = 0
wbName = Dir(FolderName & "\" & "*.xls")
While wbName <> ""
wbCount = wbCount + 1
ReDim Preserve wbList(1 To wbCount)
wbList(wbCount) = wbName
wbName = Dir
Wend
If wbCount = 0 Then Exit Sub
'从每个工作簿中获取数据
r = 0
Workbooks.Add
For i = 1 To wbCount
r = r + 1
cValue = GetInfoFromClosedFile(FolderName, wbList(i), "Sheet1", "A1")
Cells(r, 1).Formula = wbList(i)
Cells(r, 2).Formula = cValue
Next i
End Sub
‘- - - - - - - - - - - - - - - - - - - - - - -
Private Function GetInfoFromClosedFile(ByVal wbPath As String, _
wbName As String, wsName As String, cellRef As String) As Variant
Dim arg As String
GetInfoFromClosedFile = ""
If Right(wbPath, 1) <> "\" Then wbPath = wbPath & "\"
If Dir(wbPath & "\" & wbName) = "" Then Exit Function
arg = "'" & wbPath & "[" & wbName & "]" & _
wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)
On Error Resume Next
GetInfoFromClosedFile = ExecuteExcel4Macro(arg)
End Function
示例说明：本示例将读取一个文件夹内所有工作簿中工作表Sheet1上单元格A1中的值到一个新工作簿中。代码中，“C:\文件夹名”代表工作簿所在的文件夹名。
[示例03-29-03]
Sub GetDataFromClosedWorkbook()
Dim wb As Workbook
Application.ScreenUpdating = False
'以只读方式打开工作簿
Set wb = Workbooks.Open("C:\文件夹名\文件.xls", True, True)
With ThisWorkbook.Worksheets("工作表名")
'从工作簿中读取数据
.Range("A10").Formula = wb.Worksheets("源工作表名").Range("A10").Formula
.Range("A11").Formula = wb.Worksheets("源工作表名").Range("A20").Formula
.Range("A12").Formula = wb.Worksheets("源工作表名").Range("A30").Formula
.Range("A13").Formula = wb.Worksheets("源工作表名").Range("A40").Formula
End With
wb.Close False '关闭打开的源数据工作簿且不保存任何变化
Set wb = Nothing '释放内存
Application.ScreenUpdating = True
End Sub
示例说明：在运行程序时，打开所要获取数据的工作簿，当取得数据后再关闭该工作簿。将屏幕更新属性值设置为False，将看不出源数据工作簿是否被打开过。本程序代码中，“C:\文件夹名\文件.xls”、"源工作表名"代表工作簿所在的文件夹和工作簿文件名。
--------------------------------------------------------------------------------
工作表名称的使用
可以在代码中采用下面的三种方式引用工作表：
(1) 该工作表在工作簿中的位置(索引号)。索引号自工作表标签最左边向右依次计数，最左边的是第1个工作表，依次为第2个、3个……等等。
(2) 该工作表的名称，即在工作表左下角中看到的工作表标签中的名称。
(3) 该工作表的对象名称，即在创建工作表时自动分配给该工作表的名称(在VBE编辑器中的工程窗口中可以看到)。
通常，在代码中引用工作表时，我们所使用的是工作表对象的Index属性和Name属性，例如 Worksheets(1).Select或者Worksheets(“Sheet1”).Select。
但是，如果工作表的名称被改变或者工作表被重新排序或者删除其中的一些工作表后，则不能使用工作表对象的Name属性或Index属性引用所需要的工作表，这可能使已经编写好的代码出现错误。因此，我们应该考虑虽然工作簿中的工作表改变但不影响工作表引用的办法，可以使用工作表对象的名称避免这种情况，即上面所讲的第3种方式，无论是在工作簿中增加或删除其它工作表，还是对工作表排序，或者是重命名需要引用的该工作表，其对象名都不变(除非您删除该工作表，或者是在VBE窗口中重命名该对象)。工作表对象的名称可以在VBE编程器中看到，如下图2所示。例如，Sheet1(Sheet1)，左边是工作表对象的名称，右边的括号中是工作表名，括号中的工作表名可以通过在工作簿界面中改变相应的工作表标签名来改变，如果在工作表中重命名Sheet1工作表为“数据工作表”，则工程属性窗口中的名称为：Sheet1(数据工作表)。在下图2中，工作表Sheet3的对象名称是“主工作表”，而在Excel中，如果改变工作表Sheet3的名称为“数据工作表”，在VBE编程器的工程窗口中，“Sheet3”将变成“数据工作表”，但是该工作表的对象名称仍为“主工作表”，如下图3所示。
图2 图3
改变工作表对象名称的方法是，通过改变属性窗口中的(名称)或者在代码中使用Properties("_CodeName")。下面的代码将会添加一个工作表并将该工作表的对象名称命名为"ws_main"，这样，在以后的代码中就可以使用该对象名称来引用这个工作表，而不必担心工作表名称改变或工作表顺序改变。
Sub ChageWksObjectName()
Dim ws As Worksheet
Dim sPrevCodeName As String
Dim sNewCodeName As String
'设置新对象的名称
sNewCodeName = "ws_main"
'增加新工作表
Set ws = Worksheets.Add
'获取新增工作表的对象名称
sPrevCodeName = ws.CodeName
'变化新增工作表的对象名称
ThisWorkbook.VBProject.VBComponents(sPrevCodeName). _
Properties("_CodeName") = sNewCodeName
End Sub
‘- - - - - - - - - - - - - - - - - - - - - -
Sub Test()
ws_main.Range("A1").Value = "This is it!"
End Sub
下面的示例简单的介绍了工作表的引用方法。在示例中，使用了工作表Sheet1。
(1) 指定工作表的位置激活工作表。下面的代码激活工作簿中的第1个工作表，即工作表标签最左边的工作表。(如果增加或删除了其中某工作表，或者是对工作表进行排序后，可能引用的不是您想引用的工作表)
Sub ActivateFirstsheetInBook()
Sheets(1).Activate
End Sub
或者：
Sub ReferenceShtByIndexNumber()
Sheets(1).[A1:D4].Copy Sheets(2).[A1]
End Sub
(2) 通过工作表的名称激活工作表，而不管工作表处于工作簿中的什么位置以及工作表对象的代码名称。(如果该工作表被重命名后，运行代码会出错)
Sub ActivateSheet1_1()
Sheets("Sheet1").Activate
End Sub
或者：
Sub ReferenceShtByGivenName()
[Sheet1!A1:D4].Copy [Sheet2!A1]
End Sub
(3) 通过工作表对象的名称激活工作表，而不管该工作表处于工作簿中的什么位置以及该工作表的名称）
Sub ActivateSheet1_2()
Sheet1.Activate
End Sub
或者：
Sub ReferenceShtByCodeName()
Sheet1.[A1:D4].Copy Sheet2.[A1]
End Sub
工作表(Worksheet)基本操作应用示例
[示例04-01]增加工作表(Add方法)
Sub AddWorksheet()
MsgBox "在当前工作簿中添加一个工作表"
Worksheets.Add
MsgBox "在当前工作簿中的工作表sheet2之前添加一个工作表"
Worksheets.Add before:=Worksheets("sheet2")
MsgBox "在当前工作簿中的工作表sheet2之后添加一个工作表"
Worksheets.Add after:=Worksheets("sheet2")
MsgBox "在当前工作簿中添加3个工作表"
Worksheets.Add Count:=3
End Sub
示例说明：Add方法带有4个可选的参数，其中参数Before和参数After指定所增加的工作表的位置，但两个参数只能选一；参数Count用来指定增加的工作表数目。
--------------------------------------------------------------------------------
[示例04-02]复制工作表(Copy方法)
Sub CopyWorksheet()
MsgBox "在当前工作簿中复制工作表sheet1并将所复制的工作表放在工作表sheet2之前"
Worksheets("sheet1").Copy Before:=Worksheets("sheet2")
MsgBox "在当前工作簿中复制工作表sheet2并将所复制的工作表放在工作表sheet3之后"
Worksheets("sheet2").Copy After:=Worksheets("sheet3")
End Sub
示例说明：Copy方法带有2个可选的参数，即参数Before和参数After，在使用时两个参数只参选一。
--------------------------------------------------------------------------------
[示例04-03]移动工作表(Move方法)
Sub MoveWorksheet()
MsgBox "在当前工作簿中将工作表sheet3移至工作表sheet2之前"
Worksheets("sheet3").Move Before:=Worksheets("sheet2")
MsgBox "在当前工作簿中将工作表sheet1移至最后"
Worksheets("sheet1").Move After:=Worksheets(Worksheets.Count)
End Sub
示例说明：Move方法与Copy方法的参数相同，作用也一样。
--------------------------------------------------------------------------------
[示例04-04]隐藏和显示工作表(Visible属性)
[示例04-04-01]
Sub testHide()
MsgBox "第一次隐藏工作表sheet1"
Worksheets("sheet1").Visible = False
MsgBox "显示工作表sheet1"
Worksheets("sheet1").Visible = True
MsgBox "第二次隐藏工作表sheet1"
Worksheets("sheet1").Visible = xlSheetHidden
MsgBox "显示工作表sheet1"
Worksheets("sheet1").Visible = True
MsgBox "第三次隐藏工作表sheet1"
Worksheets("sheet1").Visible = xlSheetHidden
MsgBox "显示工作表sheet1"
Worksheets("sheet1").Visible = xlSheetVisible
MsgBox "第四隐藏工作表sheet1"
Worksheets("sheet1").Visible = xlSheetVeryHidden
MsgBox "显示工作表sheet1"
Worksheets("sheet1").Visible = True
MsgBox "第五隐藏工作表sheet1"
Worksheets("sheet1").Visible = xlSheetVeryHidden
MsgBox "显示工作表sheet1"
Worksheets("sheet1").Visible = xlSheetVisible
End Sub
示例说明：本示例演示了隐藏和显示工作表的各种情形。其中，使用xlSheetVeryHidden常量来隐藏工作表，将不能通过选择工作表菜单栏中的“格式”——“工作表”——“取消隐藏”命令来取消隐藏。
--------------------------------------------------------------------------------
[示例04-04-02]
Sub ShowAllSheets()
MsgBox "使当前工作簿中的所有工作表都显示(即将隐藏的工作表也显示)"
Dim ws As Worksheet
For Each ws In Sheets
ws.Visible = True
Next ws
End Sub
--------------------------------------------------------------------------------
[示例04-05]获取工作表数(Count属性)
[示例04-05-01]
Sub WorksheetNum()
Dim i As Long
i = Worksheets.Count
MsgBox "当前工作簿的工作表数为：" & Chr(10) & i
End Sub
--------------------------------------------------------------------------------
[示例04-05-02]
Sub WorksheetNum()
Dim i As Long
i = Sheets.Count
MsgBox "当前工作簿的工作表数为：" & Chr(10) & i
End Sub
示例说明：在一个包含图表工作表的工作簿中运行上述两段代码，将会得出不同的结果，原因是对于Sheets集合来讲，工作表包含图表工作表。应注意Worksheets集合与Sheets集合的区别，下同。
--------------------------------------------------------------------------------
[示例04-06]获取或设置工作表名称(Name属性)
[示例04-06-01]
Sub NameWorksheet()
Dim sName As String, sChangeName As String
sName = Worksheets(2).Name
MsgBox "当前工作簿中第2个工作表的名字为：" & sName
sChangeName = "我的工作表"
MsgBox "将当前工作簿中的第3个工作表名改为：" & sChangeName
Worksheets(3).Name = sChangeName
End Sub
示例说明：使用Name属性可以获取指定工作表的名称，也可以设置工作表的名称。
--------------------------------------------------------------------------------
[示例04-06-02]重命名工作表
Sub ReNameSheet()
Dim xStr As String
Retry:
Err.Clear
xStr = InputBox("请输入工作表的新名称:" _
, "重命名工作表", ActiveSheet.Name)
If xStr = "" Then Exit Sub
On Error Resume Next
ActiveSheet.Name = xStr
If Err.Number <> 0 Then
MsgBox Err.Number & " " & Err.Description
Err.Clear
GoTo Retry
End If
On Error GoTo 0
'.........
End Sub
--------------------------------------------------------------------------------
[NextPage][示例04-07]激活/选择工作表(Activate方法和Select方法)
[示例04-07-01]
Sub SelectWorksheet()
MsgBox "激活当前工作簿中的工作表sheet2"
Worksheets("sheet2").Activate
MsgBox "激活当前工作簿中的工作表sheet3"
Worksheets("sheet3").Select
MsgBox "同时选择工作簿中的工作表sheet2和sheet3"
Worksheets(Array("sheet2", "sheet3")).Select
End Sub
示例说明：Activate方法只能激活一个工作表，而Select方法可以同时选择多个工作表。
--------------------------------------------------------------------------------
[示例04-07-02]
Sub SelectManySheet()
MsgBox "选取第一个和第三个工作表."
Worksheets(1).Select
Worksheets(3).Select False
End Sub
--------------------------------------------------------------------------------
[示例04-08]获取当前工作表的索引号(Index属性)
Sub GetSheetIndex()
Dim i As Long
i = ActiveSheet.Index
MsgBox "您正使用的工作表索引号为" & i
End Sub
--------------------------------------------------------------------------------
[示例04-09]选取前一个工作表(Previous属性)
Sub PreviousSheet()
If ActiveSheet.Index <> 1 Then
MsgBox "选取当前工作簿中当前工作表的前一个工作表"
ActiveSheet.Previous.Activate
Else
MsgBox "已到第一个工作表"
End If
End Sub
示例说明：如果当前工作表是第一个工作表，则使用Previous属性会出错。
--------------------------------------------------------------------------------
[示例04-10]选取下一个工作表(Next属性)
Sub NextSheet()
If ActiveSheet.Index <> Worksheets.Count Then
MsgBox "选取当前工作簿中当前工作表的下一个工作表"
ActiveSheet.Next.Activate
Else
MsgBox “已到最后一个工作表”
End If
End Sub
示例说明：如果当前工作表是最后一个工作表，则使用Next属性会出错。
--------------------------------------------------------------------------------
[示例04-11]工作表行和列的操作
[示例04-11-01]隐藏行
Sub HideRow()
Dim iRow As Long
MsgBox "隐藏当前单元格所在的行"
iRow = ActiveCell.Row
ActiveSheet.Rows(iRow).Hidden = True
MsgBox "取消隐藏"
ActiveSheet.Rows(iRow).Hidden = False
End Sub
--------------------------------------------------------------------------------
[示例04-11-02]隐藏列
Sub HideColumn()
Dim iColumn As Long
MsgBox "隐藏当前单元格所在列"
iColumn = ActiveCell.Column
ActiveSheet.Columns(iColumn).Hidden = True
MsgBox "取消隐藏"
ActiveSheet.Columns(iColumn).Hidden = False
End Sub
--------------------------------------------------------------------------------
[示例04-11-03]插入行
Sub InsertRow()
Dim rRow As Long
MsgBox "在当前单元格上方插入一行"
rRow = Selection.Row
ActiveSheet.Rows(rRow).Insert
End Sub
--------------------------------------------------------------------------------
[示例04-11-04]插入列
Sub InsertColumn()
Dim cColumn As Long
MsgBox "在当前单元格所在行的左边插入一行"
cColumn = Selection.Column
ActiveSheet.Columns(cColumn).Insert
End Sub
--------------------------------------------------------------------------------
[示例04-11-05]插入多行
Sub InsertManyRow()
MsgBox "在当前单元格所在行上方插入三行"
Dim rRow As Long, i As Long
For i = 1 To 3
rRow = Selection.Row
ActiveSheet.Rows(rRow).Insert
Next i
End Sub
--------------------------------------------------------------------------------
[示例04-11-06]设置行高
Sub SetRowHeight()
MsgBox "将当前单元格所在的行高设置为25"
Dim rRow As Long, iRow As Long
rRow = ActiveCell.Row
iRow = ActiveSheet.Rows(rRow).RowHeight
ActiveSheet.Rows(rRow).RowHeight = 25
MsgBox "恢复到原来的行高"
ActiveSheet.Rows(rRow).RowHeight = iRow
End Sub
--------------------------------------------------------------------------------
[示例04-11-07]设置列宽
Sub SetColumnWidth()
MsgBox "将当前单元格所在列的列宽设置为20"
Dim cColumn As Long, iColumn As Long
cColumn = ActiveCell.Column
iColumn = ActiveSheet.Columns(cColumn).ColumnWidth
ActiveSheet.Columns(cColumn).ColumnWidth = 20
MsgBox "恢复至原来的列宽"
ActiveSheet.Columns(cColumn).ColumnWidth = iColumn
End Sub
--------------------------------------------------------------------------------
[示例04-11-08]恢复行高列宽至标准值
Sub ReSetRowHeightAndColumnWidth()
MsgBox "将当前单元格所在的行高和列宽恢复为标准值"
Selection.UseStandardHeight = True
Selection.UseStandardWidth = True
End Sub
--------------------------------------------------------------------------------
[示例04-12]工作表标签
[示例04-12-01] 设置工作表标签的颜色
Sub SetSheetTabColor()
MsgBox "设置当前工作表标签的颜色"
ActiveSheet.Tab.ColorIndex = 7
End Sub
--------------------------------------------------------------------------------
[示例04-12-01]恢复工作表标签颜色
Sub SetSheetTabColorDefault()
MsgBox "将当前工作表标签颜色设置为默认值"
ActiveSheet.Tab.ColorIndex = -4142
End Sub
--------------------------------------------------------------------------------
[示例04-12-03]交替隐藏或显示工作表标签
Sub HideOrShowSheetTab()
MsgBox "隐藏/显示工作表标签"
ActiveWindow.DisplayWorkbookTabs = Not ActiveWindow.DisplayWorkbookTabs
End Sub
--------------------------------------------------------------------------------
[NextPage][示例04-13]确定打印的页数(HPageBreaks属性与VPageBreaks属性)
Sub PageCount()
Dim i As Long
i = (ActiveSheet.HPageBreaks.Count + 1) * (ActiveSheet.VPageBreaks.Count + 1)
MsgBox "当前工作表共" & i & "页."
End Sub
--------------------------------------------------------------------------------
[示例04-14]保护/撤销保护工作表
[示例04-14-01]
Sub ProtectSheet()
MsgBox "保护当前工作表并设定密码"
ActiveSheet.Protect Password:="fanjy"
End Sub
示例说明：运行代码后，当前工作表中将不允许编辑，除非撤销工作表保护。
--------------------------------------------------------------------------------
[示例04-14-02]
Sub UnprotectSheet()
MsgBox "撤销当前工作表保护"
ActiveSheet.Unprotect
End Sub
示例说明：运行代码后，如果原保护的工作表设置有密码，则要求输入密码。
--------------------------------------------------------------------------------
[示例04-14-03]保护当前工作簿中的所有工作表
Sub ProtectAllWorkSheets()
On Error Resume Next
Dim ws As Worksheet
Dim myPassword As String
myPassword = InputBox("请输入您的密码" & vbCrLf & _
"(不输入表明无密码)" & vbCrLf & vbCrLf & _
"确保您没有忘记密码！", "输入密码")
For Each ws In ThisWorkbook.Worksheets
ws.Protect (myPassword)
Next ws
End Sub
--------------------------------------------------------------------------------
[示例04-14-04]撤销对当前工作簿中所有工作表的保护
Sub UnprotectAllWorkSheets()
On Error Resume Next
Dim ws As Worksheet
Dim myPassword As String
myPassword = InputBox("请输入您的密码" & vbCrLf & _
"(不输入表示无密码)", "输入密码")
For Each ws In ThisWorkbook.Worksheets
ws.Unprotect (myPassword)
Next ws
End Sub
--------------------------------------------------------------------------------
[示例04-14-05]仅能编辑未锁定的单元格
Sub OnlyEditUnlockedCells()
Sheets("Sheet1").EnableSelection = xlUnlockedCells
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
示例说明：运行本代码后，在当前工作表中将只能对未锁定的单元格进行编辑，而其它单元格将不能编辑。未锁定的单元格是指在选择菜单“格式——单元格”命令后所弹出的对话框中的“保护”选项卡中，未选中“锁定”复选框的单元格或单元格区域。
--------------------------------------------------------------------------------
[示例04-15]删除工作表(Delete方法)
Sub DeleteWorksheet()
MsgBox "删除当前工作簿中的工作表sheet2"
Application.DisplayAlerts = False
Worksheets("sheet2").Delete
Application.DisplayAlerts = True
End Sub
示例说明：本示例代码使用Application.DisplayAlerts = False来屏蔽弹出的警告框。
--------------------------------------------------------------------------------
<一些编程方法和技巧>
[示例04-16] 判断一个工作表(名)是否存在
[示例04-16-01]
Sub testWorksheetExists1()
Dim ws As Worksheet
If Not WorksheetExists(ThisWorkbook, "sheet1") Then
MsgBox "不能够找到该工作表", vbOKOnly
Exit Sub
End If
MsgBox "已经找到工作表"
Set ws = ThisWorkbook.Worksheets("sheet1")
End Sub
'- - - - - - - - - - - - - - - - - - -
Function WorksheetExists(wb As Workbook, sName As String) As Boolean
Dim s As String
On Error GoTo ErrHandle
s = wb.Worksheets(sName).Name
WorksheetExists = True
Exit Function
ErrHandle:
WorksheetExists = False
End Function
示例说明：在测试代码中，用相应的工作簿名和工作表名分别代替“ThisWorkbook”和“Sheet1”，来判断指定工作表是否在工作簿中存在。
--------------------------------------------------------------------------------
[示例04-16-02]
Sub testWorksheetExists2()
If Not SheetExists("<工作表名>") Then
MsgBox "<工作表名> 不存在!"
Else
Sheets("<工作表名>").Activate
End If
End Sub
'- - - - - - - - - - - - - - - - - - -
Function SheetExists(SheetName As String) As Boolean
SheetExists = False
On Error GoTo NoSuchSheet
If Len(Sheets(SheetName).Name) > 0 Then
SheetExists = True
Exit Function
End If
NoSuchSheet:
End Function
示例说明：在代码中，用实际工作表名代替<>。
--------------------------------------------------------------------------------
[示例04-16-03]
Sub TestingFunction()
'如果工作表存在则返回True，否则为False
'测试DoesWksExist1函数
Debug.Print DoesWksExist1("Sheet1")
Debug.Print DoesWksExist1("Sheet100")
Debug.Print "-----"
'测试DoesWksExist2函数
Debug.Print DoesWksExist2("Sheet1")
Debug.Print DoesWksExist2("Sheet100")
End Sub
‘- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Function DoesWksExist1(sWksName As String) As Boolean
Dim i As Long
For i = Worksheets.Count To 1 Step -1
If Sheets(i).Name = sWksName Then
Exit For
End If
Next
If i = 0 Then
DoesWksExist1 = False
Else
DoesWksExist1 = True
End If
End Function
‘- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Function DoesWksExist2(sWksName As String) As Boolean
Dim wkb As Worksheet
On Error Resume Next
Set wkb = Sheets(sWksName)
On Error GoTo 0
DoesWksExist2 = IIf(Not wkb Is Nothing, True, False)
End Function
--------------------------------------------------------------------------------
[示例04-17]排序工作表
[示例04-17-01]
Sub SortWorksheets1()
Dim bSorted As Boolean
Dim nSortedSheets As Long
Dim nSheets As Long
Dim n As Long
nSheets = Worksheets.Count
nSortedSheets = 0
Do While (nSortedSheets < nSheets) And Not bSorted
bSorted = True
nSortedSheets = nSortedSheets + 1
For n = 1 To nSheets - nSortedSheets
If StrComp(Worksheets(n).Name, Worksheets(n + 1).Name, vbTextCompare) > 0 Then
Worksheets(n + 1).Move Before:=Worksheets(n)
bSorted = False
End If
Next n
Loop
End Sub
示例说明：本示例代码采用了冒泡法排序。
--------------------------------------------------------------------------------
[示例04-17-02]
Sub SortWorksheets2()
'根据字母对工作表排序
Dim i As Long, j As Long
For i = 1 To Sheets.Count
For j = 1 To Sheets.Count - 1
If UCase$(Sheets(j).Name) > UCase$(Sheets(j + 1).Name) Then
Sheets(j).Move After:=Sheets(j + 1)
End If
Next j
Next i
End Sub
--------------------------------------------------------------------------------
[示例04-17-03]
Sub SortWorksheets3()
'以升序排列工作表
Dim sCount As Integer, i As Integer, j As Integer
Application.ScreenUpdating = False
sCount = Worksheets.Count
If sCount = 1 Then Exit Sub
For i = 1 To sCount - 1
For j = i + 1 To sCount
If Worksheets(j).Name < Worksheets(i).Name Then
Worksheets(j).Move Before:=Worksheets(i)
End If
Next j
Next i
End Sub
示例说明：若想排序所有工作表，将代码中的Worksheets替换为Sheets。
--------------------------------------------------------------------------------
[示例04-18]删除当前工作簿中的空工作表
Sub Delete_EmptySheets()
Dim sh As Worksheet
For Each sh In ThisWorkbook.Worksheets
If Application.WorksheetFunction.CountA(sh.Cells) = 0 Then
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
End If
Next
End Sub
单元格区域引用方式的小结
在使用ExcelVBA进行编程时，我们通常需要频繁地引用单元格区域，然后再使用相应的属性和方法对区域进行操作。所谓单元格区域，指的是单个的单元格、或者是由多个单元格组成的区域、或者是整行、整列等。下面，我们设定一些情形，以问答的形式对引用单元格区域的方式进行归纳。
--------------------------------------------------------------------------------
问题一：在VBA代码中，如何引用当前工作表中的单个单元格(例如引用单元格C3)？
回答：可以使用下面列举的任一方式对当前工作表中的单元格(C3)进行引用。
(1) Range("C3")
(2) [C3]
(3) Cells(3, 3)
(4) Cells(3, "C")
(5) Range("C4").Offset(-1)
Range("D3").Offset(, -1)
Range("A1").Offset(2, 2)
(6) 若C3为当前单元格，则可使用：ActiveCell
(7) 若将C3单元格命名为“Range1”，则可使用：Range("Range1")或[Range1]
(8) Cells(4, 3).Offset(-1)
(9) Range("A1").Range("C3")
--------------------------------------------------------------------------------
问题二：在VBA代码中，我要引用当前工作表中的B2:D6单元格区域，有哪些方式？
回答：可以使用下面列举的任一方式对当前工作表中单元格区域B2:D6进行引用。
(1) Range(“B2:D6”)
(2) Range("B2", "D6")
(3) [B2:D6]
(4) Range(Range("B2"), Range("D6"))
(5) Range(Cells(2, 2), Cells(6, 4))
(6) 若将B2:D6区域命名为“MyRange”，则又可以使用下面的语句引用该区域：
① Range("MyRange")
② [MyRange]
(7) Range("B2").Resize(5, 3)
(8) Range("A1:C5").Offset(1, 1)
(9) 若单元格B2为当前单元格，则可使用语句：Range(ActiveCell, ActiveCell.Offset(4, 2))
(10) 若单元格D6为当前单元格，则可使用语句：Range("B2", ActiveCell)
--------------------------------------------------------------------------------
问题三：在VBA代码中，如何使用变量实现对当前工作表中不确定单元格区域的引用？
回答：有时，我们需要在代码中依次获取工作表中特定区域内的单元格，这通常可以采取下面的几种方式：
(1) Range(“A” & i)
(2) Range(“A” & i & “:C” & i)
(3) Cells(i,1)
(4) Cells(i,j)
其中，i、j为变量，在循环语句中指定i和j的范围后，依次获取相应单元格。
--------------------------------------------------------------------------------
问题四：在VBA代码中，如何扩展引用当前工作表中的单元格区域？
回答：可以使用Resize属性，例如：
(1) ActiveCell.Resize(4, 4)，表示自当前单元格开始创建一个4行4列的区域。
(2) Range("B2").Resize(2, 2)，表示创建B2:C3单元格区域。
(3) Range("B2").Resize(2)，表示创建B2:B3单元格区域。
(4) Range("B2").Resize(, 2)，表示创建B2:C2单元格区域。
如果是在一个单元格区域(如B3:E6)，或一个命名区域中(如将单元格区域B3:E6命名为“MyRange”)使用Resize属性，则只是相对于单元格区域左上角单元格扩展区域，例如：
代码Range("C3:E6").Resize(, 2)，表示单元格区域C3：D6，并且扩展的单元格区域可不在原单元格区域内。
因此，可以知道Resize属性是相对于当前活动单元格或某单元格区域中左上角单元格按指定的行数或列数扩展单元格区域。
--------------------------------------------------------------------------------
问题五：在VBA代码中，如何在当前工作表中基于当前单元格区域或指定单元格区域处理其它单元格区域？
回答：可以使用Offset属性，例如：
(1) Range("A1").Offset(2, 2)，表示单元格C3。
(2) ActiveCell.Offset(, 1)，表示当前单元格下一列的单元格。
(3) ActiveCell.Offset(1)，表示当前单元格下一行的单元格。
(4) Range("C3:D5").Offset(, 1)，表示单元格区域D3:E5，即将整个区域偏移一列。
从上面的代码示例可知，Offset属性从所指定的单元格开始按指定的行数和列数偏移，从而到达目的单元格，但偏移的行数和列数不包括指定单元格本身。
--------------------------------------------------------------------------------
问题六：在VBA代码中，如何在当前工作表中引用交叉区域？
回答：可以使用Intersect方法，例如：
Intersect(Range("C3:E6"), Range("D5:F8"))，表示单元格区域D5:E6，即单元格区域C3:E6与D5:F8相重迭的区域。
--------------------------------------------------------------------------------
问题七：在VBA代码中，如何在当前工作表中引用多个区域？
回答：
(1) 可以使用Union方法，例如：
Union(Range("C3:D4"), Range("E5:F6"))，表示单元格区域C3:D4和E5:F6所组成的区域。
Union方法可以将多个非连续区域连接起来成为一个区域，从而可以实现对多个非连续区域一起进行操作。
(2) 也可以使用下面的代码：
Range("C3:D4, E5:F6")或[C3:D4, E5:F6]
注意：Range("C3:D4", "F5:G6")，表示单元格区域C3:G6，即将两个区域以第一个区域左上角单元格为起点，以第二个区域右下角单元格为终点连接成一个新区域。
同时，在引用区域后使用Rows属性和Columns属性时，注意下面代码的区别：
①Range("C3:D4", "F8:G10").Rows.Count，返回的值为8；
②Range("C3:D4,F8:G10").Rows.Count，返回的值为2，即只计算第一个单元格区域。
--------------------------------------------------------------------------------
问题八：在VBA代码中，如何引用当前工作表中活动单元格或指定单元格所在的区域(当前区域)？
回答：可以使用CurrentRegion属性，例如：
(1) ActiveCell.CurrentRegion，表示活动单元格所在的当前区域。
(2) Range("D5").CurrentRegion，表示单元格D5所在的当前区域。
当前区域是指周围由空行或空列所围成的区域。该属性的详细使用参见《CurrentRegion属性示例》一文。
[NextPage]
--------------------------------------------------------------------------------
问题九：在VBA代码中，如何引用当前工作表中已使用的区域？
回答：可以使用UsedRange属性，例如：
(1) Activesheet.UsedRange，表示当前工作表中已使用的区域。
(2) Worksheets("sheet1").UsedRange，表示工作表sheet1中已使用的区域。
与CurrentRegion属性不同的是，该属性代表工作表中已使用的单元格区域，包括显示为空行，但已进行过格式的单元格区域。该属性的详细使用参见《解析UsedRange属性》一文。
--------------------------------------------------------------------------------
问题十：如何在单元格区域内指定特定的单元格？
回答：可以使用Item属性，例如：
(1) Range("A1:B10").Item(5,3)指定单元格C5，这个单元格处于以区域中左上角单元格A1(即区域中第1行第1列的单元格)为起点的第5行第3列。因为Item属性为默认属性，因此也可以简写为：Range("A1:B10")(5,3)。
如果将A1:B10区域命名为”MyRange”，那么Range("MyRange")(5,3)也指定单元格C5。
(2) Range("A1:B10")(12,13)指定单元格M12，即用这种方式引用单元格，该单元格不必一定要包含在区域内。
同时，也不需要索引数值是正值，例如：
① Range("D4:F6")(0,0)代表单元格C3；
② Range("D4:F6")(-1,-2)代表单元格A2。
而Range("D4:F6")(1,1)代表单元格D4。
(3) 也可以在单元格区域中循环，例如：
Range("D4:F6")(2,2)(3,4)代表单元格H7，即该单元格位于作为左上角单元格E5的第3行第4列(因为E5是开始于区域中左上角单元格D4起的第2行第2列)。
(4) 也能使用一个单个的索引数值进行引用。计数方式为从左向右，即在区域中的第一行开始从左向右计数，第一行结束后，然后从第二行开始从左到右接着计数，依次类推。(注：从区域中第一行第一个单元格开始计数，当第一行结束时，转入第二行最左边的单元格，这样按一行一行从左向右依次计数。以单元格区域中第1个单元格开始，按上述规则依次为第2个单元格、第3个单元格….等等)，例如：
Range("A1:B2")(1) 代表单元格A1；
Range("A1:B2")(2) 代表单元格B1；
Range("A1:B2")(3) 代表单元格A2；
Range("A1:B2")(4) 代表单元格B2。
这种方法可在工作表中连续向下引用单元格(即不一定是在单元格区域内，但在遵循相同的规律)，例如：
Range("A1:B2")(5)代表单元格A3；
Range("A1:B2")(14)代表单元格B7，等等。
也可以使用单个的负数索引值。
这种使用单个索引值的方法对遍历列是有用的，例如，Range("D4")(1)代表单元格D4，Range("D4")(2)代表单元格D5，Range ("D4")(11)代表单元格D14，等等。
同理，稍作调整后也可遍历行，例如：
Range("D4").Columns(2)代表单元格E4，Range("D4").Columns(5)指定单元格H4，等等。
(5)当与对象变量配合使用时，Item属性能提供简洁并有效的代码，例如：
Set rng = Worksheets(1).[a1]
定义了对象变量后，像单元格方法一样，Item属性允许使用两个索引数值引用工作表中的任一单元格，例如，rng(3,4)指定单元格D3。(By Chip Pearson)
--------------------------------------------------------------------------------
问题十一：在VBA代码中，如何引用当前工作表中的整行或整列？
回答：见下面的示例代码：
(1) Range("C:C").Select，表示选择C列。
Range("C:E").Select，表示选择C列至E列。
(2) Range("1:1").Select，表示选择第一行。
Range("1:3").Select，表示选择第1行至第3行。
(3) Range("C:C").EntireColumn，表示C列；
Range("D1").EntireColumn，表示D列。
同样的方式，也可以选择整行，然后可以使用如AutoFit方法对整列或整行进行调整。
--------------------------------------------------------------------------------
问题十二：在VBA代码中，如何引用当前工作表中的所有单元格？
回答：可以使用下面的代码：
(1) Cells，表示当前工作表中的所有单元格。
(2) Range(Cells(1, 1), Cells(Cells.Rows.Count, Cells. Columns.Count))，其中Cells.Rows表示工作表所有行，Cells. Columns表示工作表所有列。
--------------------------------------------------------------------------------
问题十三：在VBA代码中，如何引用工作表中的特定单元格区域？
回答：在工作表中，您可能使用过“定位条件”对话框。可以通过选择菜单“编辑——定位”，单击“定位”对话框中的“定位条件”按钮显示该对话框。这个对话框可以允许用户选择特定的单元格。例如：
(1) Worksheets("sheet1").Cells.SpecialCells(xlCellTypeAllFormatConditions)，表示工作表sheet1中由带有条件格式的单元格所组成的区域。
(2) ActiveCell.CurrentRegion.SpecialCells(xlCellTypeBlanks)，表示当前工作表中活动单元格所在区域中所有空白单元格所组成的区域。
当然，还有很多常量和值的组合，可以让您实现特定单元格的查找并引用。参见《探讨在工作表中找到最后一行》一文。
--------------------------------------------------------------------------------
问题十四：在VBA代码中，如何引用其它工作表或其它工作簿中的单元格区域？
回答：要引用其它工作表或其它工作簿中的单元格区域，只需在单元格对象前加上相应的引用对象即可，例如：
(1) Worksheets(“Sheet3”).Range(“C3:D5”)，表示引用工作表sheet3中的单元格区域C3:D5。
(2) Workbooks(“MyBook.xls”).Worksheets(“sheet1”).Range(“B2”)，表示引用MyBook工作簿中工作表Sheet1上的单元格B2。
--------------------------------------------------------------------------------
问题十五：还有其它的一些情形吗？
回答：列举如下：
(1) Cells(15)，表示单元格O1，即可在Cells属性中指定单元格数字来选择单元格，其计数顺序为自左至右、从上到下，又如Cells(257)，表示单元格B1。
(2) Cells(, 256)，表示单元格IV1，但是如果Cells(, 257)，则会返回错误。
--------------------------------------------------------------------------------
结语
我们用VBA对Excel进行处理，一般是对其工作表中的数据进行处理，因此，引用单元格区域是ExcelVBA编程中最基本的操作之一，只有确定了所处理的单元格区域，才能使用相应的属性和方法进行下一步的操作。
上面列举了一些引用单元格区域的情形和方式，可以看出，引用单元格区域有很多方式，有一些可能不常用，可以根据工作表的所处的环境和个人编程习惯进行选择使用。
当然，在编写程序时，也可能会将上面的一些属性联合使用，以达到选取特定操作对象的目的，例如Offset属性、Resize属性、CurrentRegion属性、UsedRange属性等的组合。
Excel工作表探密
Sheets集合与Worksheets集合的区别
Sheets集合代表当前工作簿中的所有工作表,包括图表工作表、对话框工作表和宏表。
Worksheets集合仅代表当前工作簿中的所有工作表。
如下图1所示的工作簿。
图1
在VBE编辑器中输入如下代码进行测试：
MsgBox Sheets(1).Name ‘返回Chart1
MsgBox Worksheets(1).Name ‘返回Sheet1
MsgBox Sheets.Count ‘返回6
MsgBox Worksheets.Count ‘返回3
--------------------------------------------------------------------------------
Activate方法与Select方法的区别
当需要激活或者是选择某个工作表时，使用Sheets(1).Activate和Sheets(1).Select的作用表面上看起来是相同的。但是，如果将需要激活或者是选择的工作表隐藏后，使用Sheets(1).Select将会出现错误，而使用Sheets(1).Activate则会正常运行。如下代码：
‘- - - 下面的代码运行正常 - - - -
Sub test1()
Sheets(1).Visible = xlHidden
Sheets(1).Activate
End Sub
‘- - - 下面的代码运行错误，作用于对象的方法无效 - - - -
Sub test2()
Sheets(1).Visible = xlHidden
Sheets(1).Select
End Sub
Activate方法是用来激活对象的方法，而Select方法是用来选取对象的方法，能使用Select方法一次选取多个工作表，但不能使用Activate方法一次激活多个工作表，一次只能激活一个工作表。见下面的代码示例：
‘- - - 下面的代码运行正常 - - - -
Sub Test3()
ActiveWorkbook.Sheets(Array(1, 2, 3)).Select
End Sub
‘- - - 下面的代码运行错误，对象不支持该属性和方法 - - - -
Sub Test4()
ActiveWorkbook.Sheets(Array(1, 2, 3)).Activate
End Sub
当然，上述内容同样适用于Worksheets集合。
转载于:https://blog.51cto.com/tech4j2ee/624290
扫一扫
5076
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
