VBA Programming Objects

Application Object

Attribute VB_Name = "D01_Application"
'---
' Module    : D01_Application
' Purpose   :
'---

Option Explicit

'---
' Procedure : Application_Caption
' Purpose   :
'---
Sub Application_Caption()
    Debug.Print Application.Caption
End Sub

'---
' Procedure : Application_ActiveCell
' Purpose   :
'---
Sub Application_ActiveCell()
    Debug.Print Application.ActiveCell
End Sub

'---
' Procedure : Application_DecimalSeparator
' Purpose   :
'---
Sub Application_DecimalSeparator()
    Debug.Print Application.DecimalSeparator
End Sub

'---
' Procedure : Application_DefaultFilePath
' Purpose   :
'---
Sub Application_DefaultFilePath()
    Debug.Print Application.DefaultFilePath
End Sub

'---
' Procedure : Application_OperatingSystem
' Purpose   :
'---
Sub Application_OperatingSystem()
    Debug.Print Application.OperatingSystem
End Sub

'---
' Procedure : Application_Path
' Purpose   :
'---
Sub Application_Path()
    Debug.Print Application.Path
End Sub

'---
' Procedure : Application_StandardFont
' Purpose   :
'---
Sub Application_StandardFont()
    Debug.Print Application.StandardFont
End Sub

'---
' Procedure : Application_StandardFontSize
' Purpose   :
'---
Sub Application_StandardFontSize()
    Debug.Print Application.StandardFontSize
End Sub

'---
' Procedure : Application_UserName
' Purpose   :
'---
Sub Application_UserName()
    Debug.Print Application.UserName
End Sub

'---
' Procedure : Application_Version
' Purpose   :
'---
Sub Application_Version()
    Debug.Print Application.Version
End Sub

'---
' Procedure : Application_FindFile
' Purpose   :
'---
Sub Application_FindFile()
    Application.FindFile
End Sub

'---
' Procedure : Application_GetOpenFilename
' Purpose   :
'---
Sub Application_GetOpenFilename()
    Application.GetOpenFilename
End Sub

'---
' Procedure : Application_GetSaveAsFilename
' Purpose   :
'---
Sub Application_GetSaveAsFilename()
    Application.GetSaveAsFilename
End Sub

'---
' Procedure : Application_ThisWorkbook
' Purpose   :
'---
Sub Application_ThisWorkbook()
    Dim wb As Workbook
    Set wb = Application.ThisWorkbook
    Debug.Print wb.Name
End Sub

'---
' Procedure : Application_Range
' Purpose   :
'---
Sub Application_Range()
    Dim r As Range
    Set r = Application.Range("A1", "A10")
    Debug.Print r.Address
End Sub

'---
' Procedure : Application_Selection
' Purpose   :
'---
Sub Application_Selection()
    Dim r As Range
    Set r = Application.Selection
    Debug.Print r.Address
End Sub

'---
' Procedure : Application_Rows
' Purpose   :
'---
Sub Application_Rows()
    Dim rows As Range
    Set rows = Application.rows
    Debug.Print rows.CountLarge
    Debug.Print rows.Address
End Sub

'---
' Procedure : Application_Workbooks
' Purpose   :
'---
Sub Application_Workbooks()
    Dim wbs As Workbooks, wb As Workbook
    Set wbs = Application.Workbooks
    
    For Each wb In wbs
        Debug.Print wb.Name
    Next
End Sub

Workbooks and Workbook

Attribute VB_Name = "D02_Workbooks_Workbook"
'---
' Module    : D02_Workbooks_Workbook
' Purpose   :
'---

Option Explicit

'---
' Procedure : WorkBooks_WorkBook1
' Purpose   :
'---
Sub WorkBooks_WorkBook1()
    Dim wbs As Workbooks, wb As Workbook
    Dim i As Long
    
    Set wbs = Application.Workbooks
    Debug.Print "Workbooks opened: " & wbs.Count
    wbs.Add
    Debug.Print "Workbooks opened: " & wbs.Count
    
    For Each wb In wbs
        Debug.Print String(50, "-") & i
        Debug.Print "Activating: " & wb.Name
        wb.Activate
        Debug.Print "ActiveSheet: " & wb.ActiveSheet.Name
        Debug.Print "FullName: " & wb.FullName
        Debug.Print "HasVBProject: " & wb.HasVBProject
        Debug.Print "Path: " & wb.Path
        Debug.Print "Saved: " & wb.Saved
        Debug.Print "VBASigned: " & wb.VBASigned
        
        i = i + 1
    Next
End Sub

'---
' Procedure : WorkBooks_WorkBook2
' Purpose   :
'---
Sub WorkBooks_WorkBook2()
    Dim wbs As Workbooks, wb As Workbook
    Dim i As Long
    
    Set wbs = Application.Workbooks
    Debug.Print "Workbooks opened: " & wbs.Count

    For Each wb In wbs
        Debug.Print String(50, "-") & i
        Debug.Print "Activating: " & wb.Name
        wb.Activate
        Debug.Print "Path: " & wb.Path
        If wb.Path = "" Then
            wb.Close
        End If
        i = i + 1
    Next

End Sub

Worksheets and Worksheet

Attribute VB_Name = "D03_Worksheets_Worksheet"
'---
' Module    : D03_Worksheets_Worksheet
' Purpose   :
'---

Option Explicit

'---
' Procedure : Worksheets_Worksheet1
' Purpose   :
'---
Sub Worksheets_Worksheet1()
    Dim wb As Workbook
    Dim ws As Worksheet
    
'    Set wb = Application.ActiveWorkbook
    Set wb = Application.ThisWorkbook
    
    For Each ws In wb.Worksheets
        Debug.Print ws.Name
    Next
End Sub

'---
' Procedure : Worksheets_Worksheet2
' Purpose   :
'---
Sub Worksheets_Worksheet2()
    Dim wb As Workbook, wbs As Workbooks
    Dim ws As Worksheet, wss As Worksheets
    Dim i As Long
    
    i = 1
    Set wbs = Application.Workbooks
    
    For Each wb In wbs
        Debug.Print String(50, "-") & i
        Debug.Print wb.Name
        For Each ws In wb.Worksheets
            Debug.Print ws.Name
        Next
    Next
End Sub

'---
' Procedure : Worksheets_Worksheet3
' Purpose   :
'---
Sub Worksheets_Worksheet3()
    Dim wb As Workbook, wbs As Workbooks
    Dim ws As Worksheet
    Dim i As Long
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each ws In ThisWorkbook.Worksheets
        If Left(ws.Name, 9) = "New Sheet" Then
            Debug.Print "Deleting: " & ws.Name
            ws.Delete
        End If
    Next
    Application.DisplayAlerts = True
    
    Debug.Print String(50, "-") & 1
    Debug.Print "Number of worksheets: " & ThisWorkbook.Worksheets.Count
    
    Set ws = ThisWorkbook.Worksheets.Add(after:=ThisWorkbook.Worksheets("Sheet1"))
    ws.Name = "New Sheet1"
    ws.Move before:=ThisWorkbook.Worksheets("Sheet1")
    
    ThisWorkbook.Worksheets("Sheet1").Move before:=ThisWorkbook.Worksheets("New Sheet1")
    
    ThisWorkbook.Worksheets("New Sheet1").Copy after:=ThisWorkbook.Worksheets("New Sheet1")
    Set ws = ThisWorkbook.Worksheets("New Sheet1 (2)")
    ws.Name = "New Sheet2"
    
    Debug.Print String(50, "-") & 2
    Debug.Print "Number of worksheets: " & ThisWorkbook.Worksheets.Count
    
    ThisWorkbook.Worksheets("New Sheet1").Copy
    
    Set wbs = Application.Workbooks
    i = 1
    For Each wb In wbs
        Debug.Print String(50, "-") & i
        Debug.Print wb.Name
        For Each ws In wb.Worksheets
            Debug.Print ws.Name
        Next
    Next
    
    Application.ScreenUpdating = True
End Sub

Ranges and Range

Attribute VB_Name = "D04_Ranges_Range"
'---
' Module    : D04_Ranges_Range
' Purpose   :
'---

Option Explicit


'---
' Procedure : Ranges_Range_Demo1_SelectRange
' Purpose   :
'---
Sub Ranges_Range_Demo1_SelectRange()
    Worksheets("Sheet2").Activate
    
    Range("A5").Select
    Range("A1:B5").Select
    Range("A1:A6, C3, E1:E6, G1:I16").Select
    
End Sub


'---
' Procedure : Ranges_Range_Demo2_FormatRange
' Purpose   :
'---
Sub Ranges_Range_Demo2_FormatRange()
    Dim Rng1 As Range, Rng2 As Range, Rng3 As Range
    Dim AllCells As Range, CurrCell As Range
    
    Application.ScreenUpdating = False
    
    ThisWorkbook.Activate
    Worksheets("Sheet1").Activate
    
    Set AllCells = Worksheets("Sheet1").Cells
    AllCells.Clear
    
    Set Rng1 = Worksheets("Sheet1").Range("B2:B10")
    Set Rng2 = Worksheets("Sheet1").Range("D2:D10")
    Set Rng3 = Worksheets("Sheet1").Range("F2:F10,H2:H10")
    
    Rng1.Clear: Rng1.ClearComments: Rng1.ClearFormats: Rng1.ClearContents
    Rng2.Clear: Rng2.ClearComments: Rng2.ClearFormats: Rng2.ClearContents
    Rng3.Clear: Rng3.ClearComments: Rng3.ClearFormats: Rng3.ClearContents
    
    Rng1.Select
    Debug.Print Rng1.Address
    Debug.Print Rng1.Count
    
    Rng1 = 1
    Rng1.Copy Destination:=Range("D2")
    Rng3 = 3
    
    Rng1.Font.Name = "Arial"
    Rng1.Font.Size = 10
    Rng1.Font.Bold = True
    Rng1.BorderAround (xlContinuous)
    Rng2.BorderAround (xlDot)
    Rng3.BorderAround (xlDouble)
    
    Set CurrCell = Worksheets("Sheet1").Range("B2")
    CurrCell.AddComment ("VBA comment #1")
    Set CurrCell = Worksheets("Sheet1").Range("B3")
    CurrCell.AddComment ("VBA comment #2")
    
    CurrCell.Activate
    
    Application.ScreenUpdating = True
    
End Sub

Cells

Attribute VB_Name = "D05_Cells"
'---
' Module    : D05_Cells
' Purpose   :
'---

Option Explicit


'---
' Procedure : Cells_Demo1_Select
' Purpose   :
'---
Sub Cells_Demo1_Select()
    Worksheets("Sheet2").Activate
    
    Cells(5, 1).Select
'    Application.Wait (Now + TimeValue("0:0:5"))
    
    Cells(15, 10).Select
'    Application.Wait (Now + TimeValue("0:0:5"))
End Sub

Offset

Attribute VB_Name = "D06_Offset"
'---
' Module    : D06_Offset
' Purpose   :
'---

Option Explicit

'---
' Procedure : Offset_Demo1_Select
' Purpose   :
'---
Sub Offset_Demo1_Select()

    Worksheets("Sheet2").Activate
    Range("A1").Select
'    Application.Wait (Now + TimeValue("0:0:5"))
    Range("A1").Offset(1, 2).Select
'    Application.Wait (Now + TimeValue("0:0:5"))
    Selection.Offset(1, 1).Select
'    Application.Wait (Now + TimeValue("0:0:5"))
    Selection.Offset(1, 0).Select
'    Application.Wait (Now + TimeValue("0:0:5"))
    Selection.Offset(0, 1).Select
'    Application.Wait (Now + TimeValue("0:0:5"))
    Selection.Offset(0, -1).Select
'    Application.Wait (Now + TimeValue("0:0:5"))
    Selection.Offset(-1, 0).Select
'    Application.Wait (Now + TimeValue("0:0:5"))
    Selection.Offset(-2, -3).Select
    
End Sub

'---
' Procedure : Offset_Demo2_Selection_Resize
' Purpose   :
'---
Sub Offset_Demo2_Selection_Resize()

    Worksheets("Sheet2").Activate
    Range("A5:B10").Select
'    Application.Wait (Now + TimeValue("0:0:5"))
    Selection.Offset(1, 2).Select
'    Application.Wait (Now + TimeValue("0:0:5"))
    Selection.Resize(2, 4).Select

End Sub

Leave your comment; I love them!

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google photo

You are commenting using your Google account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s