A couple of useful workbook functions
2011-07-02 Workbooks 0 377
The built-in method Workbooks.Add creates a new workbook with a predetermined number of worksheets, usually 3, but this can be another number if the user has changed the setting for how many worksheets a new workbook should contain. I really hate to have empty, unused worksheets in my workbooks, and I am fed up with the extra hassle of writing the necessary code lines to make sure that a new workbook contains the number of worksheets I really want it to have. This first function can be used to create a new workbook with a preset number of worksheets in it, up to max 255 worksheets. If you want even more worksheets you have to add them to the workbook afterwards.
Function NewWorkbook(Optional ByVal lngCount As Long = 1) As Workbook
' creates a new workbook with lngCount (1 - 255) worksheets
Dim lngOrgCount As Long
With Application
If lngCount > 1 And lngCount < 256 Then
' use the custom worksheet count
lngOrgCount = .SheetsInNewWorkbook
.SheetsInNewWorkbook = lngCount
Set NewWorkbook = .Workbooks.Add
' reset to the original worksheet count
.SheetsInNewWorkbook = lngOrgCount
Else
' use the users own setting
Set NewWorkbook = .Workbooks.Add
End If
End With
End Function
Sub Example1()
Dim wb As Workbook
Set wb = NewWorkbook(1) ' creates a new workbook with one worksheet in it
MsgBox "Count of worksheets in the workbook: " & wb.Worksheets.Count, vbInformation
End Sub
This second function can be used to get a workbook, usually after retrieving a filename from the user with the Application.GetOpenFilename method or reading it from an input cell in a worksheet. The function below will first check if the workbook is already open, if not it will try to open the workbook using the supplied filename.
Function GetWorkbook(strFullFilename As String, Optional blnReadOnly As Boolean = False, _
Optional blnUpdateLinks As Boolean = False, Optional strPassword As String = vbNullString, _
Optional blnWorkbookWasOpen As Boolean = False) As Workbook
' returns a Workbook object if the strFullFilename refers to an open workbook or one that can be opened
' if the workbook is already open, blnWorkbookWasOpen will return True
Dim p As Long, strFilename As String
blnWorkbookWasOpen = False
If Len(strFullFilename) < 3 Then Exit Function
strFilename = strFullFilename
' determine if strFullFilename contains a folder path
p = InStrRev(strFullFilename, Application.PathSeparator)
If p = 0 Then
p = InStrRev(strFullFilename, "/") ' url location?
End If
If p > 0 Then ' contains a full filepath, get the filename only
strFilename = Mid(strFullFilename, p + 1)
End If
On Error Resume Next
' check if the workbook is already open
Set GetWorkbook = Workbooks(strFilename)
blnWorkbookWasOpen = Not GetWorkbook Is Nothing
If GetWorkbook Is Nothing Then ' it was not open
' try to open the workbook
Set GetWorkbook = Workbooks.Open(strFullFilename, blnUpdateLinks, blnReadOnly, , strPassword)
End If
On Error GoTo 0
End Function
Sub Example2()
Dim strFileName As String, wb As Workbook, blnOpenWB As Boolean
strFileName = "Excel Workbooks (*.xl*),*.xl*,All Files (*.*),*.*"
strFileName = Application.GetOpenFilename(strFileName, 1, "Select a workbook:")
If Len(strFileName) < 6 Then Exit Sub ' no filename returned
Set wb = GetWorkbook(strFileName, , , , blnOpenWB)
If wb Is Nothing Then Exit Sub ' no workbook found
' do something useful with the open workbook
With wb
.Worksheets(1).Range("A1").Formula = "Last Opened: " & Format(Now, "yyyy-mm-dd hh:mm")
' if the workbook was open, save changes and close it
If blnOpenWB Then
.Close True ' close and save changes
'.Close False ' close without saving changes
'.Close ' close and ask the user about saving changes
End If
End With
Set wb = Nothing
End Sub