内容发布更新时间 : 2024/11/7 18:42:57星期一 下面是文章的全部内容请认真阅读。
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
‘- - - - - - - - - - - - - - - - - - - - - - - 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 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) = \ Set awb = ActiveWorkbook If awb.Path = \
Application.Dialogs(xlDialogSaveAs).Show Else
BackupFileName = awb.Name OK = False
On Error GoTo NotAbleToSave
If Dir(\ Kill \ End If With awb
Application.StatusBar = \正在保存工作簿...\ .Save
Application.StatusBar = \正在备份工作簿...\ .SaveCopyAs \ OK = True End With End If
NotAbleToSave:
Set awb = Nothing
Application.StatusBar = False If Not OK Then
MsgBox \备份工作簿未保存!\ End If End Sub 示例说明：本程序将把当前工作簿进行复制并以与当前工作簿相同的名称保存在D盘中。其中，使用了Kill方法来删除已存在的工作簿。
示例03-29：从已关闭的工作簿中取值 [示例03-29-01]
Sub testGetValuesFromClosedWorkbook()
GetValuesFromAClosedWorkbook \End Sub
‘- - - - - - - - - - - - - - - - - - - - - - - Sub GetValuesFromAClosedWorkbook(fPath As String, _
fName As String, sName, cellRange As String) With ActiveSheet.Range(cellRange)
.FormulaArray = \ & sName & \ .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 = \文件夹名\ '创建文件夹中工作簿列表 wbCount = 0
wbName = Dir(FolderName & \ 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), \\
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) <> \ If Dir(wbPath & \ arg = \
wsName & \ 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(\文件夹名\\文件.xls\ With ThisWorkbook.Worksheets(\工作表名\ '从工作簿中读取数据
.Range(\源工作表名\
.Range(\源工作表名\
.Range(\源工作表名\
.Range(\源工作表名\ End With
wb.Close False '关闭打开的源数据工作簿且不保存任何变化 Set wb = Nothing '释放内存
Application.ScreenUpdating = True End Sub
示例说明：在运行程序时，打开所要获取数据的工作簿，当取得数据后再关闭该工作簿。将屏幕更新属性值设置为False，将看不出源数据工作簿是否被打开过。本程序代码中，“C:\\文件夹名\\文件.xls”、\源工作表名\代表工作簿所在的文件夹和工作簿文件名。
[示例04-01]增加工作表(Add方法) Sub AddWorksheet()
MsgBox \在当前工作簿中添加一个工作表\ Worksheets.Add
MsgBox \在当前工作簿中的工作表sheet2之前添加一个工作表\ Worksheets.Add before:=Worksheets(\
MsgBox \在当前工作簿中的工作表sheet2之后添加一个工作表\ Worksheets.Add after:=Worksheets(\ MsgBox \在当前工作簿中添加3个工作表\ Worksheets.Add Count:=3 End Sub
示例说明：Add方法带有4个可选的参数，其中参数Before和参数After指定所增加的工作表的位置，但两个参数只能选一；参数Count用来指定增加的工作表数目。
[示例04-02]复制工作表(Copy方法) Sub CopyWorksheet()
MsgBox \在当前工作簿中复制工作表sheet1并将所复制的工作表放在工作表sheet2之前\