VBA/Excel/Access/Word/Application/Application

Материал из VB Эксперт
Перейти к: навигация, поиск

Содержание

Application.InchesToPoints

   <source lang="vb">

Sub Macro1_Version2()

   With ActiveSheet.PageSetup
       .LeftMargin = Application.InchesToPoints(1.5)
       .RightMargin = Application.InchesToPoints(1.5)
       .TopMargin = Application.InchesToPoints(1.5)
       .BottomMargin = Application.InchesToPoints(1.5)
       .HeaderMargin = Application.InchesToPoints(1)
       .FooterMargin = Application.InchesToPoints(1)
   End With

End Sub

</source>
   
  


Application.Path

   <source lang="vb">

Sub main()

   MsgBox Application.Path & "\EXCEL.EXE"

End Sub

</source>
   
  


Benchmark with/without setting the Application.ScreenUpdating

   <source lang="vb">

Sub WriteReadRange()

   Dim MyArray()
   Dim Time1 As Date
   Range("A:A").ClearContents
   NumElements = 1000
   If NumElements = "" Then Exit Sub
   ReDim MyArray(1 To NumElements)
   For i = 1 To NumElements
       MyArray(i) = i
   Next i
   
   Application.ScreenUpdating = False
   Time1 = Timer
   For i = 1 To NumElements
       Cells(i, 1) = i
   Next i
   WriteTime = Format(Timer - Time1, "00:00")
   
   Time1 = Timer
   For i = 1 To NumElements
       MyArray(i) = Cells(i, 1)
   Next i
   ReadTime = Format(Timer - Time1, "00:00")
   Application.ScreenUpdating = True
   
   Debug.Print "Write: " & WriteTime
   Debug.Print "Read: " & ReadTime

End Sub

</source>
   
  


CalculationVersion: Right four digits indicate the version of the calculation engine whereas the digits to the left indicate the major version of Excel.

   <source lang="vb">

Sub InspectTheEnvironment()

   Debug.Print Application.CalculationVersion 

End Sub

</source>
   
  


Clearing the Recently Used Files List

   <source lang="vb">

Sub clear()

   Dim myMax As Long
   With Application.RecentFiles
       myMax = .Maximum
       .Maximum = 0
       .Maximum = myMax
   End With

End Sub

</source>
   
  


Cursors Available to Use with the Cursor Property

   <source lang="vb">

Sub ViewCursors()

   Application.Cursor = xlNorthwestArrow 
   MsgBox "Do you like the xlNorthwestArrow? Hover over the worksheet to see it." 
   Application.Cursor = xlIBeam 
   MsgBox "How about the xlIBeam? Hover over the worksheet to see it." 
   Application.Cursor = xlWait 
   MsgBox "How about xlWait? Hover over the worksheet to see it." 
   Application.Cursor = xlDefault 
   MsgBox "Back to the default..." 

End Sub

</source>
   
  


Demonstration of Window size Properties

   <source lang="vb">

Sub GetWindowInfo()

   Dim lState As Long 
   Dim sInfo As String 
   Dim lResponse As Long 
   " Prepare message to be displayed 
   sInfo = sInfo & "Usable Height = " & Application.UsableHeight & vbCrLf 
   sInfo = sInfo & "Usable Width = " & Application.UsableWidth & vbCrLf 
   sInfo = sInfo & "Height = " & Application.Height & vbCrLf 
   sInfo = sInfo & "Width = " & Application.Width & vbCrLf & vbCrLf 
   lResponse = MsgBox(sInfo, vbYesNo, "Window Info") 
   " Minimize window if user clicked Yes 
   If lResponse = vbYes Then 
       Application.WindowState = xlMinimized 
   End If 

End Sub

</source>
   
  


Display application in full screen mode

   <source lang="vb">

Sub FullScreen_Icon()

 If Application.DisplayFullScreen Then
   Application.DisplayFullScreen = False
   Application.WindowState = xlMinimized
 Else
   Application.DisplayFullScreen = True
 End If

End Sub

</source>
   
  


Execute the next statement to set the calculation mode to automatic:

   <source lang="vb">

Sub calcu()

   Application.Calculation = xlCalculationAutomatic

End Sub

</source>
   
  


Get application user name

   <source lang="vb">

Private Sub CommandButton1_Click()

   MsgBox "Hello " & Application.UserName

End Sub

</source>
   
  


Get window state information

   <source lang="vb">

Sub GetWindowInfo()

   Dim lState As Long 
   lState = Application.WindowState 
   Select Case lState 
       Case xlMaximized 
           Debug.Print "Window is maximized."
       Case xlMinimized 
           Debug.Print  "Window is minimized." 
       Case xlNormal 
           Debug.Print  "Window is normal." & vbCrLf 
   End Select 

End Sub

</source>
   
  


If you need to avoid user interaction you can turn off alerts in Excel by setting the DisplayAlerts property of the Application object to False before deleting the worksheet and then turning alerts back on again:

   <source lang="vb">

Sub alert()

   Application.DisplayAlerts = False
   myWorkbook.Sheets("Summary").Delete
   Application.DisplayAlerts = True

End Sub

</source>
   
  


Listing Application CommandBars

   <source lang="vb">

Sub Inventory()

   Dim cb As commandBar
   For Each cb In Application.rumandBars
       Debug.Print cb.name
       Debug.Print cb.Index
       Debug.Print cb.BuiltIn
       Debug.Print cb.Enabled
       Debug.Print cb.Visible
       Debug.Print cb.Controls.Count
   Next
   Set cb = Nothing

End Sub

</source>
   
  


Make sure that the help file can be located:

   <source lang="vb">

Sub GetHelp()

   Path = ThisWorkbook.Path
   Application.Help Path & "\USER.HLP"

End Sub

</source>
   
  


MemoryFree Returns the amount of memory in bytes that Excel is allowed to use, not including memory already in use.

   <source lang="vb">

Sub InspectTheEnvironment()

   Debug.Print Application.MemoryFree 

End Sub

</source>
   
  


MemoryTotal Returns the total amount of memory, in bytes, that Excel can use. It includes memory that is already in use. It is the sum of MemoryFree and MemoryUsed.

   <source lang="vb">

Sub InspectTheEnvironment()

   Debug.Print Application.MemoryTotal 

End Sub

</source>
   
  


MemoryUsed Returns the amount of memory, in bytes, that Excel is currently using.

   <source lang="vb">

Sub InspectTheEnvironment()

   Debug.Print Application.MemoryUsed 

End Sub

</source>
   
  


OperatingSystem Returns the name and version of the Operating System.

   <source lang="vb">

Sub InspectTheEnvironment()

   Debug.Print Application.OperatingSystem 

End Sub

</source>
   
  


OrganizationName Returns the name of the organization to which the product is registered.

   <source lang="vb">

Sub InspectTheEnvironment()

   Debug.Print Application.OrganizationName 

End Sub

</source>
   
  


Performance Implications of Screen Updating

   <source lang="vb">

Sub TimeScreenUpdating()

   Dim dResult As Double 
   dResult = TestScreenUpdating(True) 
   MsgBox Format(dResult, "0.00") & " seconds.", vbOKOnly 
   dResult = TestScreenUpdating(False) 
   MsgBox Format(dResult, "0.00") & " seconds.", vbOKOnly 

End Sub Function TestScreenUpdating(bUpdatingOn As Boolean) As Double

   Dim nRepetition As Integer 
   Dim ws As Worksheet 
   Dim dStart As Double 
   dStart = Timer 
   Application.ScreenUpdating = bUpdatingOn 
   For nRepetition = 1 To 250 
       For Each ws In ThisWorkbook.Worksheets 
           ws.Activate 
       Next 
   Next 
   Application.ScreenUpdating = True 
   TestScreenUpdating = Timer - dStart 
   Set ws = Nothing 

End Function

</source>
   
  


Pick the Perfect Location with GetSaveAsFilename

   <source lang="vb">

Sub SimpleGetSaveAsFilename()

   Dim sFile As String 
   sFile = Application.GetSaveAsFilename 
   Debug.Print sFile  

End Sub

</source>
   
  


Quitting Application

   <source lang="vb">

Sub quit()

   Application.Quit

End Sub

</source>
   
  


Setting a Default File Location

   <source lang="vb">

Sub def()

   Application.DefaultFilePath = "\\server3\users\mjones\files"

End Sub

</source>
   
  


Specifying the proper Excel version: Warn users who attempt to open the add-in using Excel 97

   <source lang="vb">

Sub CheckVersion()

   If Val(Application.Version) < 9 Then
       MsgBox "This works only with Excel 2000 or later"
   End If

End Sub

</source>
   
  


start Access

   <source lang="vb">

Sub Start()

   Application.ActivateMicrosoftApp xlMicrosoftAccess

End Sub

</source>
   
  


start Foxpro

   <source lang="vb">

Sub Start()

   Application.ActivateMicrosoftApp xlMicrosoftFoxPro

End Sub

</source>
   
  


start mail client

   <source lang="vb">

Sub Start()

   Application.ActivateMicrosoftApp xlMicrosoftMail

End Sub

</source>
   
  


start Power point

   <source lang="vb">

Sub Start()

   Application.ActivateMicrosoftApp xlMicrosoftPowerPoint 

End Sub

</source>
   
  


start Project

   <source lang="vb">

Sub Start()

   Application.ActivateMicrosoftApp xlMicrosoftProject

End Sub

</source>
   
  


start schedule

   <source lang="vb">

Sub Start()

   Application.ActivateMicrosoftApp xlMicrosoftSchedulePlus

End Sub

</source>
   
  


start word

   <source lang="vb">

Sub StartWord()

   Application.ActivateMicrosoftApp xlMicrosoftWord

End Sub

</source>
   
  


System Information Available Using Application Object Properties

   <source lang="vb">

Sub InspectTheEnvironment()

   Debug.Print Application.CalculationVersion 

End Sub

</source>
   
  


To avoid these alert messages, insert the following VBA statement in your macro:

   <source lang="vb">

Sub alert()

   Application.DisplayAlerts = False

End Sub

</source>
   
  


Toggles the calculation mode between manual and automatic and displays a message indicating the current mode:

   <source lang="vb">

Sub ToggleCalcMode()

   Select Case Application.Calculation
       Case xlManual
           Application.Calculation = xlCalculationAutomatic
           MsgBox "Automatic Calculation Mode"
       Case xlAutomatic
           Application.Calculation = xlCalculationManual
           MsgBox "Manual Calculation Mode"
   End Select

End Sub

</source>
   
  


Turning off automatic calculation: Sets the Excel calculation mode to manual

   <source lang="vb">

Sub cal()

   Application.Calculation = xlCalculationManual

End Sub

</source>
   
  


Turning off screen updating

   <source lang="vb">

Sub update()

   Application.ScreenUpdating = False
   Application.ScreenUpdating = True

End Sub

</source>
   
  


UserName Returns or sets the name of the current user.

   <source lang="vb">

Sub InspectTheEnvironment()

   Debug.Print Application.UserName 

End Sub

</source>
   
  


Use the Application object qualifier to set properties

   <source lang="vb">

Sub appProperty()

   Application.Calculation = xlManual
   Application.EditDirectlyInCell = False
   Application.DefaultFilePath = "C:\My Documents"
   

End Sub

</source>
   
  


Using the StatusBar property to Display Information

   <source lang="vb">

Sub TimeStatusBar()

   Dim dStart As Double
   Dim dResult As Double
   Dim bDisplayStatusBar As Boolean
   bDisplayStatusBar = Application.DisplayStatusBar
   Application.DisplayStatusBar = True
   dStart = timer
   TestStatusBar 1, False
   dResult = timer - dStart
   MsgBox Format(dResult, "0.00") & " seconds.", vbOKOnly
   dStart = timer
   TestStatusBar 1, True
   dResult = timer - dStart
   MsgBox Format(dResult, "0.00") & " seconds.", vbOKOnly
   dStart = timer
   TestStatusBar 5, True
   dResult = timer - dStart
   MsgBox Format(dResult, "0.00") & " seconds.", vbOKOnly
   Application.DisplayStatusBar = bDisplayStatusBar

End Sub Sub TestStatusBar(nInterval As Integer, bUseStatusBar As Boolean)

   Dim lRow As Long
   Dim lLastRow As Long
   Dim ws As Worksheet
   Set ws = ThisWorkbook.Worksheets(1)
   lLastRow = ws.Rows.Count
   For lRow = 1 To lLastRow
       If lRow Mod nInterval = 0 Then
           If bUseStatusBar Then
               Application.StatusBar = "Processing row: " & lRow & _
               " of " & lLastRow & " rows."
           End If
       End If
   Next
   Application.StatusBar = False
   Set ws = Nothing

End Sub

</source>
   
  


Version Returns the version of Excel that is in use.

   <source lang="vb">

Sub InspectTheEnvironment()

   Debug.Print Application.Version 

End Sub

</source>