в 16:33, 26 мая 2010

2010-05-26T16:33:00Z

Admin: 1 версия

2010-05-26T12:46:17Z

1 версия

Новая страница

==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>

← Предыдущая	Версия 16:33, 26 мая 2010
(нет различий)

VBA/Excel/Access/Word/Application/Application - История изменений

в 16:33, 26 мая 2010

Admin: 1 версия