A couple of useful workbook functions
2011-07-02 Workbooks 0 142
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 SubThis 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