实例一：判断工作簿是否存在
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”代表工作簿所在的文件夹名、子文件夹名和工作簿文件名。
实例二：判断工作簿是否已打开
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
实例三：保存当前工作簿的副本到其它位置备份工作簿
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方法来删除已存在的工作簿。
实例四：从已关闭的工作簿中取值
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单元格区域内获取数据，并将其复制到当前工作表相应单元格区域中。
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
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
vba做excel窗体录入教程arg = "'" & wbPath & "[" & wbName & "]" & _
wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)
On Error Resume Next
GetInfoFromClosedFile = ExecuteExcel4Macro(arg)
End Function
示例说明：本示例将读取一个文件夹内所有工作簿中工作表Sheet1上单元格A1中的值到一个新工作簿中。代码中，“C:\文件夹名”代表工作簿所在的文件夹名。
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
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”、"源工作表名"代表工作簿所在的文件夹和工作簿文件名。
实例五：将文本文件导入工作簿中(OpenText方法)
Sub TextToWorkbook()
'本示例打开某文本文件并将制表符作为分隔符对此文件进行分列处理转换成为工作表
Workbooks.OpenText Filename:="<；文本文件所在的路径>/<；文本文件名>", _
DataType:=xlDelimited, Tab:=True
End Sub
示例说明：代码中的<>里的内容需用所载入的文本文件所在路径及文件名代替。OpenText方法的作用是导入一个文本文件，并将其作为包含单个工作表的工作簿进行分列处理，然后在此工作表中放入经过分列处理的文本文件数据。该方法共有18个参数，其中参数FileName为必需的参数，其余参数可选。
实例六：测试工作簿中是否包含指定工作表(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
版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。
发表评论