VBA/Excel/Access/Word/Excel/Workbook

Add a new workbook and save it

   <source lang="vb">

Public Sub SaveActiveWorkbook()

 Application.Workbooks.Add
 Call Application.ActiveWorkbook.SaveAs("temp.xls")

End Sub

</source>
   
  

arranges the open workbooks in a tiled configuration

   <source lang="vb">

Private Sub AppEvent_NewWorkbook(ByVal Wb As Workbook)

   Application.Windows.Arrange xlArrangeStyleTiled

End Sub

</source>
   
  

Center workbook

   <source lang="vb">

Sub CenterBook()

   Dim bookWidth As Integer
   Dim bookHeight As Integer
   bookWidth = Application.UsableWidth
   bookHeight = Application.UsableHeight
   ActiveWindow.WindowState = xlNormal
   Workbooks("Center.xls").Windows(1).Width = bookWidth
   Workbooks("Center.xls").Windows(1).Height = bookHeight
   Workbooks("Center.xls").Windows(1).Left = 0
   Workbooks("Center.xls").Windows(1).Top = 0

End Sub

</source>
   
  

Check Whether a Sheet in an Open Workbook Exists

   <source lang="vb">

Function SheetExists(SName As String, Optional WB As workBook) As Boolean

   Dim WS As Worksheet
   If WB Is Nothing Then
       Set WB = ActiveWorkbook
   End If
   On Error Resume Next
       SheetExists = CBool(Not WB.Sheets(SName) Is Nothing)
   On Error GoTo 0

End Function Sub CheckForSheet()

   Dim ShtExists As Boolean
   ShtExists = SheetExists("Sheet1")
   If ShtExists Then
       MsgBox "The worksheet exists!"
   Else
       MsgBox "The worksheet does NOT exist!"
   End If

End Sub

</source>
   
  

Check Whether a Workbook Is Open

   <source lang="vb">

Function BookOpen(Bk As String) As Boolean

   Dim T As Excel.workBook
   Err.clear "clears any errors
   On Error Resume Next
   Set T = Application.Workbooks(Bk)
   BookOpen = Not T Is Nothing
   
   Err.clear
   On Error GoTo 0

End Function Sub OpenAWorkbook()

   Dim IsOpen As Boolean
   Dim BookName As String
   BookName = "yourFile.xlsm"
   IsOpen = BookOpen(BookName)
   If IsOpen Then
       MsgBox BookName & " is already open!"
   Else
       Workbooks.Open (BookName)
   End If

End Sub

</source>
   
  

Close a workbook and save it

   <source lang="vb">

Sub CloseWorkbook()

  Dim Workbook1 As Workbook
 
  Set Workbook1 = Workbooks.Open(FileName:=ThisWorkbook.Path & "\Temp.xls")
  Range("A1").Value = Format(Date, "ddd mmm dd, yyyy")
  Range("A1").EntireColumn.AutoFit
  Workbook1.Close SaveChanges:=True

End Sub

</source>
   
  

Controlling Worksheet Visibility

   <source lang="vb">

Sub SetWorksheetVisibility()

   Dim myWorksheet As Worksheet 
   On Error Resume Next 
   Set myWorksheet = ThisWorkbook.Worksheets("Checks and Options") 
   Application.ScreenUpdating = False 
   ThisWorkbook.Worksheets("Sheet1").Visible = True 
   ThisWorkbook.Worksheets("Sheet2").Visible = True
   ThisWorkbook.Worksheets("Sheet3").Visible = True
   Application.ScreenUpdating = True 
   Set myWorksheet = Nothing 

End Sub

</source>
   
  

Count the Number of Workbooks in a Directory

   <source lang="vb">

Function NumFilesInCurDir(Optional strInclude As String = "")

   Dim myFileSystemObject As FileSystemObject
   Dim fld As folder
   Dim fil As file
   Dim subfld As folder
   Dim intFileCount As Integer
   Dim strExtension As String
     strExtension = "XLS"
     Set myFileSystemObject = New FileSystemObject
     Set fld = myFileSystemObject.GetFolder(ThisWorkbook.Path)
     For Each fil In fld.Files
       If UCase(fil.name) Like "*" & UCase(strInclude) & "*." & UCase(strExtension) Then
         intFileCount = intFileCount + 1
       End If
     Next fil
     For Each subfld In fld.SubFolders
         intFileCount = intFileCount + NumFilesInCurDir(strInclude)
     Next subfld
     NumFilesInCurDir = intFileCount
     Set myFileSystemObject = Nothing

End Function Sub CountMyWkbks()

   Dim MyFiles As Integer
   MyFiles = NumFilesInCurDir("MrE*")
   MsgBox MyFiles & " file(s) found"

End Sub

</source>
   
  

Create a new workbook

   <source lang="vb">

Sub NewWorkbooks()

  Dim myWorkbook1 As Workbook
  Dim myWorkbook2 As Workbook

  Set myWorkbook1 = Workbooks.Add
  Set myWorkbook2 = Workbooks.Add
  Application.DisplayAlerts = False
  myWorkbook1.SaveAs FileName:="E:\SalesData1.xls"

End Sub

</source>
   
  

Create a workbook and save it as a new file

   <source lang="vb">

Public Sub SaveSpecificWorkbook2()

 Dim W As Workbook
 Set W = Application.Workbooks.Add
 Call W.SaveAs("temp2.xls")
 

End Sub

</source>
   
  

Creates a new workbook and adds it to the collection, reads the number of workbooks into a variable, and selects all worksheets in the active workbook:

   <source lang="vb">

Sub workbookAdd()

   Workbooks.Add
   numWorkbooks = Workbooks.Count
   Worksheets.Select

End Sub

</source>
   
  

Get workbook format

   <source lang="vb">

Sub GetFileFormat()

   Dim lFormat As Long
   Dim sFormat As String
   Dim wb As Workbook
   Set wb = ActiveWorkbook
   
   lFormat = wb.FileFormat
   Select Case lFormat
       Case xlAddIn: sFormat = "Add-in"
       Case xlCSV: sFormat = "CSV"
       Case xlCSVMac: sFormat = "CSV Mac"
       Case xlCSVMSDOS: sFormat = "CSV MS DOS"
       Case xlCSVWindows: sFormat = "CSV Windows"
       Case xlCurrentPlatformText: sFormat = "Current Platform Text"
       Case xlDBF2: sFormat = "DBF 2"
       Case xlDBF3: sFormat = "DBF 3"
       Case xlDBF4: sFormat = "DBF 4"
       Case xlDIF: sFormat = "DIF"
       Case xlExcel2: sFormat = "Excel 2"
       Case xlExcel2FarEast: sFormat = "Excel 2 Far East"
       Case xlExcel3: sFormat = "Excel 3"
       Case xlExcel4: sFormat = "Excel 4"
       Case xlExcel4Workbook: sFormat = "Excel 4 Workbook"
       Case xlExcel5: sFormat = "Excel 5"
       Case xlExcel7: sFormat = "Excel 7"
       Case xlExcel9795: sFormat = "Excel 97/95"
       Case xlHtml: sFormat = "HTML"
       Case xlIntlAddIn: sFormat = "Int"l AddIn"
       Case xlIntlMacro: sFormat = "Int"l Macro"
       Case xlSYLK: sFormat = "SYLK"
       Case xlTemplate: sFormat = "Template"
       Case xlTextMac: sFormat = "Text Mac"
       Case xlTextMSDOS: sFormat = "Text MS DOS"
       Case xlTextPrinter: sFormat = "Text Printer"
       Case xlTextWindows: sFormat = "Text Windows"
       Case xlUnicodeText: sFormat = "Unicode Text"
       Case xlWebArchive: sFormat = "Web Archive"
       Case xlWJ2WD1: sFormat = "WJ2WD1"
       Case xlWJ3: sFormat = "WJ3"
       Case xlWJ3FJ3: sFormat = "WJ3FJ3"
       Case xlWK1: sFormat = "WK1"
       Case xlWK1ALL: sFormat = "WK1ALL"
       Case xlWK1FMT: sFormat = "WK1FMT"
       Case xlWK3: sFormat = "WK3"
       Case xlWK3FM3: sFormat = "WK3FM3"
       Case xlWK4: sFormat = "WK4"
       Case xlWKS: sFormat = "WKS"
       Case xlWorkbookNormal: sFormat = "Normal workbook"
       Case xlWorks2FarEast: sFormat = "Works 2 Far East"
       Case xlWQ1: sFormat = "WQ1"
       Case xlXMLSpreadsheet: sFormat = "XML Spreadsheet"
       Case Else: sFormat = "Unknown format code"
   End Select
   Debug.Print sFormat

End Sub

</source>
   
  

maximizes any workbook when it is activated

   <source lang="vb">

Private Sub AppEvent_WorkbookActivate(ByVal Wb as Workbook)

   Wb.WindowState = xlMaximized

End Sub

</source>
   
  

Open a workbook and then size it to fit just within the application window

   <source lang="vb">

Public Sub OpenBook()

   Workbooks.Open ActiveWorkbook.Path & "\MyWorkbook.xls"
   FitWindow

End Sub Private Sub FitWindow()

   Dim winWidth As Integer
   Dim winHeight As Integer
   winWidth = Application.UsableWidth "Get the usable width of app window
   winHeight = Application.UsableHeight

End Sub

</source>
   
  

Open workbook by name

   <source lang="vb">

Sub Array2()

 Dim Data As Variant, myWorkbook As Workbook
 Dim i As Integer
 Data = Array("A", "B", "C", "D")
 For i = LBound(Data) To UBound(Data)
   Set myWorkbook = Workbooks.Open(FileName:=Data(i) & ".xls")
   MsgBox myWorkbook.Name
   myWorkbook.Close SaveChanges:=True
 Next i

End Sub

</source>
   
  

places the username in the footer of each sheet printed:

   <source lang="vb">

Private Sub AppEvent_WorkbookBeforePrint(ByVal Wb As Workbook,Cancel As Boolean)

   Wb.ActiveSheet.PageSetup.LeftFooter = Application.UserName

End Sub

</source>
   
  

Save workbook and close

   <source lang="vb">

Sub CloseWorkbook()

  Dim myWorkbook1 As workBook

  Set myWorkbook1 = Workbooks.Open(Filename:="E:\SalesData.xls")
  Range("A1").Value = Format(Date, "ddd mmm dd, yyyy")
  Range("A1").EntireColumn.AutoFit
  myWorkbook1.Close SaveChanges:=True

End Sub

</source>
   
  

The distinction between the Workbook and Window objects lies in an additional method that can be used to create a Window object

   <source lang="vb">

Sub newWindow()

   Windows(1).newWindow

End Sub

</source>
   
  

The Workbooks property is a member of the Application object and returns a reference to the Workbook object specified by the index value given in the parentheses.

   <source lang="vb">

Sub changePro()

   Workbooks(1).Windows(1).WindowState = xlNormal
   Workbooks(1).Windows(1).Width = 500
   Workbooks(1).Windows(1).Height = 300

End Sub

</source>
   
  

To close all open workbooks, use the Close method of the Workbooks collection object.

   <source lang="vb">

Sub closeDemo()

   Workbooks.Close

End Sub

</source>
   
  

To close a single workbook, use the Close method of the Workbook object. The Close method accepts three optional arguments (SaveChanges, FileName, and RouteWorkbook).

   <source lang="vb">

Sub save()

   Workbooks("MyWorkbook.xls").Close SaveChanges:=False

End Sub

</source>
   
  

To save a workbook from a VBA program, use either the Save methods of the Workbook object.

   <source lang="vb">

Sub saveWorkBook()

   Workbooks("MyWorkbook.xls").save

End Sub

</source>
   
  

To select the last Workbook object in the collection

   <source lang="vb">

Sub workbookSelect()

   Workbooks(Workbooks.Count).Activate

End Sub

</source>
   
  

Use Application object to save a workbook as a new file

   <source lang="vb">

Public Sub SaveSpecificWorkbook1()

 Application.Workbooks.Add
 Call Application.ActiveWorkbook.SaveAs("temp1.xls")
 Application.Workbooks("temp1.xls").SaveAs ("copy of temp1.xls")

End Sub

</source>
   
  

Use a String rather than an index value to reference a workbook

   <source lang="vb">

Sub workbookSelectName()

   Workbooks("MyWorkbook.xls").Activate

End Sub

</source>