開啟 A(新)工作簿,即使它已經開啟
如果要訪問已開啟的工作簿,則從 Workbooks
集合中獲取分配非常簡單:
dim myWB as Workbook
Set myWB = Workbooks("UsuallyFullPathnameOfWorkbook.xlsx")
如果要建立新工作簿,請使用 Workbooks
集合物件來建立新條目。
Dim myNewWB as Workbook
Set myNewWB = Workbooks.Add
有時你可能不會或(或關心)你所需的工作簿是否已開啟,或者可能不存在。示例函式顯示如何始終返回有效的工作簿物件。
Option Explicit
Function GetWorkbook(ByVal wbFilename As String) As Workbook
'--- returns a workbook object for the given filename, including checks
' for when the workbook is already open, exists but not open, or
' does not yet exist (and must be created)
' *** wbFilename must be a fully specified pathname
Dim folderFile As String
Dim returnedWB As Workbook
'--- check if the file exists in the directory location
folderFile = File(wbFilename)
If folderFile = "" Then
'--- the workbook doesn't exist, so create it
Dim pos1 As Integer
Dim fileExt As String
Dim fileFormatNum As Long
'--- in order to save the workbook correctly, we need to infer which workbook
' type the user intended from the file extension
pos1 = InStrRev(sFullName, ".", , vbTextCompare)
fileExt = Right(sFullName, Len(sFullName) - pos1)
Select Case fileExt
Case "xlsx"
fileFormatNum = 51
Case "xlsm"
fileFormatNum = 52
Case "xls"
fileFormatNum = 56
Case "xlsb"
fileFormatNum = 50
Case Else
Err.Raise vbObjectError + 1000, "GetWorkbook function", _
"The file type you've requested (file extension) is not recognized. " & _
"Please use a known extension: xlsx, xlsm, xls, or xlsb."
End Select
Set returnedWB = Workbooks.Add
Application.DisplayAlerts = False
returnedWB.SaveAs filename:=wbFilename, FileFormat:=fileFormatNum
Application.DisplayAlerts = True
Set GetWorkbook = returnedWB
Else
'--- the workbook exists in the directory, so check to see if
' it's already open or not
On Error Resume Next
Set returnedWB = Workbooks(sFile)
If returnedWB Is Nothing Then
Set returnedWB = Workbooks.Open(sFullName)
End If
End If
End Function