Excel VBA Application Object Essentials

Application Object Overview

Optimizing Display Performance with ScreenUpdating

Sub MeasureScreenUpdate()
    Dim elapsed As Double
    
    'Test with screen updating enabled
    elapsed = UpdateTest(True)
    MsgBox Format(elapsed, "0.00") & " seconds"
    
    'Test with screen updating disabled
    elapsed = UpdateTest(False)
    MsgBox Format(elapsed, "0.00") & " seconds"
End Sub

Function UpdateTest(enableUpdate As Boolean) As Double
    Dim startTime As Double
    Dim counter As Integer
    Dim sheet As Worksheet
    
    startTime = Timer
    Application.ScreenUpdating = enableUpdate
    
    For counter = 1 To 250
        For Each sheet In ThisWorkbook.Sheets
            sheet.Activate
        Next
    Next
    
    Application.ScreenUpdating = True
    UpdateTest = Timer - startTime
End Function

Providing User Feedback via Status Bar

Sub TestStatusUpdates()
    Dim statusEnabled As Boolean
    Dim result As Double
    
    statusEnabled = Application.DisplayStatusBar
    Application.DisplayStatusBar = True
    
    'Baseline without status updates
    result = StatusTest(100, False)
    MsgBox Format(result, "0.00") & " seconds"
    
    'With status updates
    result = StatusTest(100, True)
    MsgBox Format(result, "0.00") & " seconds"
    
    Application.DisplayStatusBar = statusEnabled
End Sub

Private Sub StatusTest(interval As Integer, useStatus As Boolean)
    Dim row As Long
    Dim lastRow As Long
    Dim targetSheet As Worksheet
    
    Set targetSheet = ThisWorkbook.Sheets(1)
    lastRow = targetSheet.Rows.Count
    
    For row = 1 To lastRow
        If row Mod interval = 0 Then
            If useStatus Then
                Application.StatusBar = "Processing row: " & row & _
                    " of " & lastRow
            End If
        End If
    Next
    
    Application.StatusBar = False
End Sub

Customizing Cursor Display

Sub DemonstrateCursors()
    Application.Cursor = xlNorthwestArrow
    MsgBox "Northwest arrow cursor visible"
    
    Application.Cursor = xlIBeam
    MsgBox "IBeam cursor visible"
    
    Application.Cursor = xlDefault
    MsgBox "Default cursor restored"
End Sub

Retrieving Window Information

Sub DisplayWindowMetrics()
    Dim state As Long
    Dim info As String
    
    state = Application.WindowState
    Select Case state
        Case xlMaximized: info = "Window maximized" & vbCrLf
        Case xlMinimized: info = "Window minimized" & vbCrLf
        Case xlNormal: info = "Window normal" & vbCrLf
    End Select
    
    info = info & "Usable height: " & Application.UsableHeight & vbCrLf
    info = info & "Usable width: " & Application.UsableWidth
    MsgBox info, vbOKOnly
End Sub

Essential Excel Object Properties

  • ActiveCell: Currently selected cell
  • ActiveSheet: Currently active worksheet
  • ActiveWorkbook: Currently active workbook
  • Selection: Current user selection
  • ThisWorkbook: Workbook containing the code
  • Caller: Cell calling user-defined function

File Selection Methods

Function SelectExcelFile(title As String) As String
    Dim filter As String
    filter = "Excel Files (*.xlsx),*.xlsx"
    SelectExcelFile = Application.GetOpenFilename(filter, , title)
End Function

Function SelectMultipleFiles(title As String) As Variant
    Dim filter As String
    filter = "Excel Files (*.xlsx),*.xlsx"
    SelectMultipleFiles = Application.GetOpenFilename(filter, , title, True)
End Function

Filename Parsing Utility

Sub ParseFileName()
    Dim fullPath As String
    Dim fileName As String
    Dim path As String
    
    fullPath = Application.GetSaveAsFilename
    ExtractNameParts fullPath, fileName, path
    
    MsgBox "Filename: " & fileName & vbCrLf & "Path: " & path
End Sub

Sub ExtractNameParts(fullPath As String, ByRef namePart As String, ByRef pathPart As String)
    Dim pos As Integer
    pos = InStrRev(fullPath, "\")
    
    If pos > 0 Then
        namePart = Mid(fullPath, pos + 1)
        pathPart = Left(fullPath, pos - 1)
    End If
End Sub

Environment Information Retrieval

Sub ShowEnvironmentDetails()
    Debug.Print "OS: " & Application.OperatingSystem
    Debug.Print "Username: " & Application.UserName
    Debug.Print "Excel Version: " & Application.Version
End Sub

Additional Useful Members

Sub ClearClipboard()
    Application.CutCopyMode = False
End Sub

Sub GetUserInput()
    Dim userName As String
    userName = Application.InputBox("Enter your name:", "User Info", Application.UserName)
    MsgBox "Welcome, " & userName
End Sub

Thẻ: ExcelVBA ApplicationObject ScreenUpdating StatusBar FileDialogs

Đăng vào ngày 20 tháng 5 lúc 15:00