Docstoc

SAMPLES

Document Sample
SAMPLES Powered By Docstoc
					Microsoft Excel 2000 Samples File
Table of Contents

Worksheet Functions
Sample formulas to complete common worksheet tasks.

Conditional Formatting
Demonstrates how to change the formatting (I.e. font, cell color) applied to a cell depending on the current value of the cell.

Data Validation
Shows how to set up restrictions for the values that can be entered into a cell.

Chart Labeling
A macro to automate the labeling of an XY-Scatter chart.

Repeating Tasks
Sample looping macro code and an explanation of how to modify recorded code to repeat tasks on a range of cells or a selected range.

Microsoft provides examples of Visual Basic for Applications procedures for illustration only, without warranty either expres not limited to the implied warranties of merchantability and/or fitness for a particular purpose. The Visual Basic procedures 'as is' and Microsoft does not guarantee that they can be used in all situations. While Microsoft Technical Support Engineers functionality of a particular macro, they will not modify these examples to provide added functionality, nor will they help y specific needs. If you have limited programming experience, you may want to consult one of the Microsoft Solution Providers.

el 2000 Samples File
Arrays
Macro code to demonstrate how to transfer array contents to a worksheet.

able of Contents

API (Application Programming Interface) Examples
How to implement the use of API calls from within Microsoft Excel's programming environment.

Events
Examples to demonstrate how some events can trigger macro code to run.

Automation
Sample macro code to demonstrate how Microsoft Excel can automate other Microsoft Office applications.

ADO - ActiveX Data Objects
Examples that illustrate common database tasks via code

res for illustration only, without warranty either expressed or implied, including, but or a particular purpose. The Visual Basic procedures in this workbook are provided all situations. While Microsoft Technical Support Engineers can help explain the to provide added functionality, nor will they help you construct macros to meet your nce, you may want to consult one of the Microsoft Solution Providers.

Worksheet Functions Examples
This worksheet contains sample formulas you can use to complete common spreadsheet tasks. Cells containing formulas are blue. To view a sample formula, hover your mouse cursor over the cell to display the comment. Or, press CTRL+` to switch between displaying values and displaying formulas on the worksheet. For more information about a worksheet function, select the cell containing the function, then click the Edit Formula (=) button on the Formula bar.

Suppressing the Display of Error Values
It is common for worksheet formulas to return an error value (#DIV/0!, #N/A, #VALUE!,#REF!, and #NUM!) if they are based on an unexpected value. An example is a simple division formula. If the source cell contains a zero, and #DIV/0! Error will be returned. Source A Source B Original Formula New Formula 25 0 #DIV/0! A general way to express this is: =IF(ISERROR(<formula>),"",<formula>) where <formula> is the formula for which you want to suppress the error value. If <formula> returns an error, this statement returns "" (a null character), otherwise it returns the result of <formula>. Another way to suppress the display of error values is to use the Conditional Formatting feature, new to Excel 97. The Conditional Formatting feature allows you to have a cell display different formats depending on the contents of the cell. For error values, you need to follow these steps: 1. Select the cell to be formatted (in this case $E$40) 2. Click Conditional Formatting on the Format menu 3. In the first dropdown box, select Formula Is 4. In the edit box next to it, type: =ISERROR($E$40) 5. Click on the format button, and select a format, in this case, a blue background and the same blue font was used. 6. Click OK The result is that for error values, the font color is the same as the background, and nothing will be displayed. Source A Source B Original Format 25 0 #DIV/0! New Format #DIV/0!

Indexing, Matching, and Looking Up Values
One of the most common List Management tasks is to find the value at the intersection of a column and a row in a rectangular range of cells on a worksheet. The Lookup Wizard helps you to write formulas to accomplish this task. To use this feature, select a cell within the data range that you would like to use, then select Tools / Wizard / Lookup, and follow the steps in the wizard.

If the menu items are not present and for additional information on how to use or install the Lookup Wizard, use the Office Assistant and perform a search using the phrase "Lookup Wizard".

Conditional Sum Formulas
Another common task in Excel is to calculate the sum of the values meeting the conditions you specify. The Conditional Sum Wizard helps you write formulas that accomplish this task. To use this feature, select a cell within the list that you would like to summarize, then select Tools / Wizard / Conditional Sum, and follow the steps in the wizard. If the menu items are not present and for additional information on how to use or install the Conditional Sum Wizard, use the Office Assistant and perform a search using the phrase "Conditional Sum Wizard".

Conditional Formatting
Conditional Formatting allows you to change the formatting applied to cell depending on the current value of the cell. This can make auditing large worksheets much faster by automatically highlighting exceptions. Conditional Formatting allows you to apply up to three separate conditions to a cell. Conditional Formatting allows you to change the font style, borders, and cell patterns. Conditional Formatting Example #1 Cells H10:H14 contain three Conditional Formatting rules that will change the formatting of the cells depending on the values entered into the cells. To see the conditions applied to the cells, select cell H10, and then click Conditional Formatting on the Format menu. 4 7 text 1 15

Conditional Formatting Example #2 - Hiding Error Values This example illustrates how to use Conditional Formatting to hide error values that are returned by formulas. In this example, cells H21 and H23 would normally display the #DIV/0! error code. The Conditional Formatting that has been applied sets the font color of the cells containing an error value to match the background of the worksheet. To see the conditions applied to the cells, select cell H19, and then click Conditional Formatting on the Format menu. 2.5 4 #DIV/0! 5 #DIV/0!

10 20 30 40 50

4 5 8

Data Validation
Data Validation allows you to set up restrictions for the values that can be entered into a cell. The following examples present several common scenarios for using Data Validation. Data Validation Example #1 - Restricting Entry to Numeric Values Cells H9:H13 have been formatted with a validation rule that restricts cell entries to numeric values. This example utilizes the Stop style for the Error alert, which prevents you from making an invalid entry into the selected cell. To see the Validation settings for this example, select cell H9, and then click Validation on the Data menu. Data Validation Example #2 - Restricting the Length of a Text Entry Cells H19:H23 have been formatted with a validation rule that restricts the length of text entries to seven characters or less. This example utilizes the Warning style for the Error alert, which gives you the option to cancel the current entry, or enter the invalid value into the selected cell. To see the Validation settings for this example, select cell H19, and then click Validation on the Data menu. Data Validation Example #3 - Restricting Entry to a Range of Whole Numbers Cells H30:H34 have been formatted with a validation rule that will alert you if you do not enter a whole number between 1 and 10. This example utilizes the Information style for the Error alert, which informs you of an invalid entry, but allows you to keep the current value. To see the Validation settings for this example, select cell H30, and then click Validation on the Data menu. Data Validation Example #4 - Restricting Cell Entry to a List of Values Cells H41:H45 have been formatted with a validation rule that restricts the entries to a list of values. The list of valid entries is contained in cells M41:M49. When you select a cell within the range H41:H45, a dropdown arrow appears on the cell. When you click the arrow, the list of valid entries is displayed. You can simply click the entry that you wish to make. This example utilizes the Stop style for the Error alert, which prevents you from making an invalid entry in the cell. To see the Validation settings for this example, select cell H41, and then click Validation on the Data menu.

Bob Chris David John Mike Perry Randal Steve Tim

Attaching Labels to an XY (Scatter) Chart
Labels X Values Y Values Datapoint1 2 5 Datapoint2 9 7 Datapoint3 5 3 Datapoint4 4 8
In Microsoft Excel, there is no built-in way to automatically attach text labels to an xy (scatter) chart. You can use a macro to accomplish this.
The attached macro demonstrates how to apply labels to an xy (scatter) chart, and assumes that your data and associated labels are arranged on your worksheet in the same fashion as the shaded cells above. To apply the data point labels, press the "Place Labels on Chart" Button.

Place Labels on

Reset Chart

View Code

Y Values 9 8
7

6 5 4 3
2

To remove the labels for another demo, press the "Reset Chart" button. To view the macro code attached to the sheet, press the "View Code" button.

1 0
0 2 4 6 8

View Code

Y Values

10

Repeating Tasks
Often it is necessary to perform the same task on a group of items. These items may be cells in a range, worksheets in a workbook or workbooks in the application. Although the macro recorder cannot record loops, the recorder can still be used to record the main task to be repeated. Then, with some minor modifications to the recorded code, various types of loops can be created depending on what is needed for an individual project. The samples below focus on a scenario where the programmer has a range of cells in column A containing numbers, and depending on the value of the cell, wishes to change the color of the corresponding cell in column B.

First, we can record the single step process of changing the color of the background of a cell: To record: From the Tools menu, click Macro, then click Record New Macro. While recording, from the Format menu, click Cells. Then, click the Patterns tab and select a color. This sample uses yellow (.ColorIndex=6). Now stop the recorder using the Stop button on the Stop Recording toolbar. The currently selected cell will change color and the following macro will have been recorded:

Sub Recorded_Macro() ' ' Macro recorded 11/18/98 ' With Selection.Interior .ColorIndex = 6 .Pattern = xlSolid End With End Sub

Goto Recorded_Macro Sample Code

Note: If, while recording, you selected a cell, your macro may contain something similar to Range("A3").Select. You may want to remove this line, since every time the macro is run, this line will force the cell specified in the Range object to be selected. If you want that cell to be selected first then leave that line in the macro. Now, we can modify the code slightly and add one of the various looping structures to the recorded code.

For Each...Next Loop
If we know what range of cells to which we want to apply the recorded action, we can use a For Each…Next loop. In this example, we also want to only affect the cell in column B if the cell in A is greater than 20. To do this we add an If statement around our recorded With statement. This will ensure the color will be changed only if the If statement's condition is true. Lastly, because we are wanting to change the corresponding cell one column to the right of column A (column B), we will replace the Selection property in the recorded code with the Offset method of the looping cell object (cell_in_loop). The resulting code might look like this

Sub For_Each_Next_Sample() ' ' Macro recorded 11/18/98 ' For Each cell_in_loop In Range("A1:A5") If cell_in_loop.Value > 20 Then With cell_in_loop.Offset(0, 1).Interior .ColorIndex = 6 .Pattern = xlSolid End With End If Next End Sub

Goto For_Each_Next Sample Code

For…Next Loop
If you know how many times you wish to loop through your code you can use a For...Next loop. Using our example, if you want to only check ten cells down, starting from the selected cell, then your modified recorded code might look like this: Goto For..Next Sample For_Next Code

Sub For_Next_Sample() For Counter = 0 To 9 If Selection.Offset(Counter, 0).Value > 20 Then With Selection.Offset(Counter, 1).Interior .ColorIndex = 6 .Pattern = xlSolid End With End If Next End Sub

Here the Selection object is being used so that the code is not specific to any given range, but will always loop through ten (0 to 9 as a counter) cells below the active cell. The Counter variable increments each time through the loop and can be used within the looping structure. Here it is used as an Offset argument to indicate how many rows to offset from Selection (the current cell). So, if we start this macro and the active cell is A1, the first time through the loop the Counter variable will equal 0, therefore we will Offset 0 rows from A1 as shown in the Selection.Offset(Counter, 0).Value statement.

Do…Loop
To determine whether or not to stop a loop based on a certain condition, a Do…Loop might be appropriate. This looping structure allows you to check properties or variable conditions before the loop is executed. In the sample below, we continue to loop until the referenced cell's row number, Selection.Offset(Counter, 0).Row, has exceeded 100. This can be useful if you never want to perform the looping task below row 100.

Sub Do_Loop_Sample() Counter = 0 Do Until Selection.Offset(Counter, 0).Row > 100 If Selection.Offset(Counter, 0).Value > 20 Then With Selection.Offset(Counter, 1).Interior .ColorIndex = 6 .Pattern = xlSolid End With End If Counter = Counter + 1 Loop End Sub

Goto Do_Loop Sample

Note: There are three more types of Do…Loops available. The various forms offer more flexibility when needed in various circumstances. To find more information about these, and more detail about the other looping structures, please access Help from within the Visual Basic Environment and use the keyword looping.

Working with Arrays
The most common way to transfer the contents of an array to a worksheet is through a loop, such as a For...Next loop. A For...Next loop allows you to index into the array and transfer elements of the array to their destination address one at a time. You can accomplish this same result without a loop using the Visual Basic, Applications Edition, FormulaArray property of the Range object. In Visual Basic, Applications Edition, the orientation of a one-dimensional array is horizontal. Therefore, if the range of cells on a worksheet that are to receive the contents of an array are also in the same orientation (that is, one row by several columns), the contents can be transferred with a single FormulaArray statement. For example:

Sub ArrayDump1() 'For a one-dimensional horizontal array Dim x(1 To 10) As Double 'Declares an array of size 10 For j = 1 To 10 'Calculates sample values x(j) = j * j Next j 'Transfers array contents to a horizontal area Range(Cells(2, 1), Cells(2, 10)).FormulaArray = x End Sub The above example works correctly when the destination worksheet cells involve only one row. However, when the contents of an array need to be transferred to a range of cells with a vertical, as opposed to a horizontal orientation (that is, one column by several rows), the above example is no longer valid.

Goto ArrayDump1 Sample Code

Within a two-dimensional array you must change the orientation of the array. To do this, you can declare the array a two-dimensional array with dimensions of several rows by one column. For example: Sub arraydump2() 'For a two-dimensional vertical array 'Declares an array ten rows by one column Dim x(1 To 10, 1 To 1) As Double 'Calculates random values For j = 1 To 10 x(j, 1) = j * j Next j 'Transfers array contents to a vertical area Range(Cells(1, 2), Cells(10, 2)).FormulaArray = x End Sub The two-dimensional array shown in this example allows Visual Basic to set the orientation of the array as vertical; therefore, the array can be transferred to a worksheet without a loop. Goto ArrayDump2 Sample Code

oto ArrayDump1 Sample Code

oto ArrayDump2 Sample Code

API Examples
An API (Application Programming Interface) is a function contained in DLL file. These functions are normally used by windows and other applications but they can also be used by the end user. Note: Exercise care when experimenting with API calls. Save your work often to avoid any problems. Because they were designed to be called by the system and by applications, most error trapping has not been implemented. This means that you may cause system hangs, crashes or other unintended side effects when experimenting with API calls. The following examples show how to use some of the basic APIs. These have been tested under Windows98 and Excel 2000. There are multiple ways to use these functions and it is up to the programmer to determine which is best for the result they are

Checking all drive letters

Goto Get_Logical_Drive_String

The following example uses the function GetLogicalDriveStrings to loop through all logical drives. Logical drives are removable, fixed, CD drives and mapped network shares.

Option Explicit Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA (ByVal nBufferLength As Long, _ ByVal lpBuffer As String) As Long Goto Get_System_Metrics Sub Get_Logical_Drive_String() Dim DrvString As String Dim TotDrvs As Long Dim Counter As Integer

Goto Get_Logical_Drive_String Sample Code

'TotDrvs returns the total number of characters in return string TotDrvs = GetLogicalDriveStrings(0&, DrvString)Goto Get_User_Name 'DrvString is the buffer created to hold the string DrvString = String(TotDrvs - 1, " ") 'Calling GetLogicalDriveStrings a second time fills the string with valid data 'example "a:\ c:\ d:\ e:\ " TotDrvs = GetLogicalDriveStrings(TotDrvs, DrvString) 'Parse through the return string displaying each in a msgbox For Counter = 1 To TotDrvs Step 4 Goto Get_Short_Name MsgBox Mid(DrvString, Counter, 3) Next Counter End Sub

Returning Video Resolution
The following code example returns the current screen video resolution and displays the information in a message box. Goto Get_Computer_Name Option Explicit Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

'Constants for GetSystemMetrics Const SM_CXSCREEN = 0 Const SM_CYSCREEN = 1 ' Width of screen ' Height of screen Goto GetDiskFreeSpace

Sub Get_System_Metrics() Goto Get_System_Metrics Dim XVal As Long, YVal As Long Sample Code YVal = GetSystemMetrics(SM_CYSCREEN) Goto GetSystemDirectory XVal = GetSystemMetrics(SM_CXSCREEN) MsgBox "Your Screen Resolution is " & XVal & " by " & YVal End Sub

Retrieving logged on user name
Goto Num_Devs The following code will return the currently logged on user name. Option Explicit Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _ (ByVal lpBuffer As String, _ nSize As Long) As Long Sub Get_User_Name()
Goto SetOnTop

Goto Get_User_Name Dim lpBuff As String * 25 Sample Code Dim ret As Long, UserName As String ret = GetUserName(lpBuff, 25) UserName = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1) MsgBox UserName End Sub

Return the short path name of a long path and file name
The following function takes a Long File Name and returns the Short File name displaying both in a message box. Private Declare Function GetShortPathName Lib "KERNEL32.DLL" Alias "GetShortPathNameA" _ (ByVal lpctstrLongName As String, _ ByVal lptstrShortName As String, _ ByVal bufLen As Long) As Long Sub Get_Short_Name() Dim LongStr As String, ShortStr As String Dim lStrLen As Long, lRet As Long

Goto Get_Short_Name Sample Code

'LongStr is any long file name or variable pointing to a file

LongStr = ThisWorkbook.FullName lRet = GetShortPathName(LongStr, ShortStr, lStrLen) 'This allows us to create a buffer the same length as 'the returned string, saving us the trouble of having 'to strip the left of the buffer to get the string ShortStr = String(lRet, " ") lRet = GetShortPathName(LongStr, ShortStr, lRet) MsgBox LongStr & " was converted to " & ShortStr End Sub

Return the Computer Name
The following code example shows how to use the GetComputerName function to return the computer name.

Option Explicit Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuf nSize As Long) As Long

Sub Get_Computer_Name() Goto Get_Computer_Name Dim Comp_Name_B As String * 255 Sample Code Dim Comp_Name As String GetComputerName Comp_Name_B, Len(Comp_Name_B) 'but the string is always ended with a null terminated string so we can use the Chr(0) fu Comp_Name = Left(Comp_Name_B, InStr(Comp_Name_B, Chr(0))) 'and return only the computer name MsgBox Comp_Name End Sub

Find the free space available on hard drive
The following code example shows how to find the free space available as well as the total hard drive size.

Option Explicit Private Declare Function GetDiskFreeSpace Lib "KERNEL32.DLL" Alias "GetDiskFreeSpaceA" (ByVal dwSectors As Long, _ dwBytes As Long, _ dwFreeClusters As Long, _ dwTotalClusters As Long) As Long Sub Get_Disk_Free_Space() Dim f As Long, iSectors As Long Goto Get_Disk_Free_Space Dim iTotal As Long, rTotal As Long Sample Code Dim iFree As Long, rFree As Long Dim iBytes As Long Dim sName As String, s As String sName = "C:\" f = GetDiskFreeSpace(sName, iSectors, iBytes, iFree, iTotal) rFree = iSectors * iBytes * CDbl(iFree) rTotal = iSectors * iBytes * CDbl(iTotal) If f Then

s = sName s = s & " has " & Format(rFree, "#,###,###,##0") s = s & " bytes free from " & Format(rTotal, "#,###,##0") & " Total bytes" End If MsgBox s End Sub

Returning the system folder location
The following code example show how to retrieve the system folder location.

Option Explicit Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffe ByVal nSize As Long) As Long Sub Get_System_Directory() Dim Sys_Dir As String, Res As Long Res = GetSystemDirectory(Sys_Dir, 0&) Sys_Dir = String(Res - 1, " ") Res = GetSystemDirectory(Sys_Dir, Res) MsgBox Sys_Dir End Sub

Goto GetSystemDirectory Sample Code

Finding out if the system is capable of playing WAV files
The following code example polls the system to see if there are any devices capable of playing WAV files. Option Explicit Declare Function waveOutGetNumDevs Lib "winmm" () As Long Sub Num_Devs() Dim i As Long i = waveOutGetNumDevs() If i > 0 Then ' There is at least one device. MsgBox "You Can Play Wave Data" Else MsgBox "Cannot Play Wave Data" End If End Sub

Goto Num_Devs Sample Code

Setting Excel to "Always on Top"
The following code example shows how to make Microsoft Excel "Always on Top". This prevents other applications from being displayed in front of Microsoft Excel.

Option Explicit Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As St ByVal lpWindowName As String) As Long Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, _ ByVal hWndInsertAfter As Long, _

ByVal ByVal ByVal ByVal ByVal Global Const HWND_TOPMOST = -1 Global Const HWND_NOTOPMOST = -2

x As Long, _ y As Long, _ cx As Long, _ cy As Long, _ wFlags As Long) As Long

Goto SetOnTop Sample Code

Sub SetOnTop() Dim WinHnd As Long, SUCCESS As Long WinHnd = FindWindow("xlmain", Application.Caption) SUCCESS = SetWindowPos(WinHnd, HWND_TOPMOST, 0, 0, 0, 0, Flags) 'The following line is here just to switch Excel back to normal operation 'after 20 seconds Application.OnTime Now + TimeValue("00:00:20"), "NotOnTop" End Sub Sub NotOnTop() Dim WinHnd As Long, SUCCESS As Long WinHnd = FindWindow("xlmain", Application.Caption) SUCCESS = SetWindowPos(WinHnd, HWND_NOTOPMOST, 0, 0, 0, 0, Flags) End Sub

not been implemented. menting with API calls. dows98 and Excel 2000. est for the result they are looking for.

ogicalDriveStringsA" _ Length As Long, _ As String) As Long

ng) As Long

rtPathNameA" _

NameA" (ByVal lpBuffer As String, _

n use the Chr(0) function to find the end

kFreeSpaceA" (ByVal lpRoot As String, _

ryA" (ByVal lpBuffer As String, _ g) As Long

r applications

l lpClassName As String, _

Programming with Events
Often programmers wish to have a certain event trigger a macro to perform some task. Microsoft Excel 2000 offers this capability. Events are always associated with an object. Examples of these might be a worksheet, or a workbook. In this sample file we will only discuss a few of the events available and use a MsgBox as a filler to demonstrate where regular code could go. To find out more about any of these and other events, click on the assistant while in the VBE and use the object name and the word "events" as your keywords. (e.g. worksheet events).

BeforeDoubleClick
A very popular type of Event is the BeforeDoubleClick event on a worksheet. A very simple example may look like: Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean) MsgBox "You double clicked on cell " & Target.Address Cancel = True End Sub This event will fire whenever the user double-clicks a cell in the worksheet. The parameter Target is passed into the macro so the programmer will know what cell has been double clicked. The Cancel argument has a default value of False but can be changed to True within the code. Setting Cancel to True will cancel the default action for the event. In this case, the default action for a double click on a cell is to switch to edit mode on the cell. Since we set Cancel to True, this will not occur. If you want to still have the default action occur, then the Cancel=True line can be removed.

Change
Another very useful event is the Change event for a worksheet. Any time the user enters a new value in any cell this event fires. Private Sub Worksheet_Change(ByVal Target As Excel.Range) MsgBox "This sheet has changed in cell " & Target.Address End Sub Note: This event does not occur if the sheet has just been recalculated. There is an event called Calculate which will fire when the worksheet recalculates.

BeforeClose
A useful Workbook related event is BeforeClose. These events can be used to perform "housekeeping" tasks before a file is saved or closed. Sub Workbook_BeforeClose(Cancel As Boolean) a = MsgBox("Do you really want to close the workbook?", vbYesNo) If a = vbNo Then Cancel = True End Sub In this example, the user is prompted to close the file regardless if the file has been saved or not.

Using Events with the Application Object

Before you can use events with the Application object, you must create a new class module and declare an object of type Application with the keyword WithEvents. For example, assume that a new class module is created and called EventClassModule. The new class module contains the following code. Public WithEvents App As Application After the new object has been declared with events, it appears in the Object drop-down list box in the class module, and you can write event procedures for the new object. (When you select the new object in the Object box, the valid events for that object are listed in the Procedure drop-down list box.) Before the procedures will run, however, you must connect the declared object in the class module with the Application object. You can do this with the following code from any module. Dim X As New EventClassModule Sub InitializeApp() Set X.App = Application End Sub After you run the InitializeApp procedure, the App object in the class module points to the Microsoft Excel Application object, and the event procedures in the class module will run when the events occur. Note: To find out more information on all events, please consult the VBA Help file for further information.

Automation
Automation is a feature of the Component Object Model (COM), a technology that applications use to expose their objects to development tools, macro languages, and other applications that support Automation. For example, a spreadsheet application may expose a worksheet, chart, cell, or range of cells each as a different type of object. A word processor might expose objects such as an application, a document, a paragraph, a sentence, a bookmark, or a selection. The following examples demonstrate automating tasks between Microsoft Excel and other Microsoft applications. For more information on Automation, refer to Understanding Automation in VBA Help. MICROSOFT ACCESS This example returns the location of the Microsoft Access sample databases.

Sub MS_Access() Dim AccDir As String Dim acc As Object 'OLE automation to Access Set acc = CreateObject("access.application") 'Return the path for msaccess.exe AccDir = acc.SysCmd(Action:=acSysCmdAccessDir) 'Display the path MsgBox "MSAccess.exe is located in " & AccDir 'Free up variable storage space Set acc = Nothing End Sub

Goto MS_Access Automation Code

MICROSOFT WORD This example copies the chart from the Chart Labels sheet into a new Microsoft Word document.

Sub MS_Word() Dim wd As Object 'Create a Microsoft Word session Set wd = CreateObject("word.application") 'Copy the chart on the Chart Labels sheet Goto MS_Word Worksheets("Chart Labeling").ChartObjects(1).Chart.ChartArea.Copy Automation Code 'Make document visible wd.Visible = True 'Activate MS Word AppActivate wd.Name With wd 'Create a new document in Microsoft Word .Documents.Add 'Insert a paragraph .Selection.TypeParagraph 'Paste the chart .Selection.PasteSpecial link:=True, DisplayAsIcon:=False, Placement:=wdInLine End With Set wd = Nothing End Sub MICROSOFT POWERPOINT This example copies the chart from the Chart Labels sheet into a new Microsoft PowerPoint presentation.

Sub MS_PowerPoint() Dim ppt As Object, pres As Object 'Create a Microsoft PowerPoint session Set ppt = CreateObject("powerpoint.application") 'Copy the chart on the Chart Labels Demo sheet Worksheets("Chart Labeling").ChartObjects(1).Copy 'Create a new document in Microsoft PowerPoint Set pres = ppt.Presentations.Add 'Add a slide pres.Slides.Add 1, ppLayoutBlank 'Make PowerPoint visible ppt.Visible = True 'Activate PowerPoint AppActivate ppt.Name 'Paste the chart ppt.ActiveWindow.View.Paste Set ppt = Nothing End Sub

Goto MS_Powerpoint

MICROSOFT OUTLOOK This example creates and adds information to a new Outlook task. Run Outlook and click Tasks on the Outlook bar to see the new task. NOTE: It may take a few minutes for the task to appear.

Sub MS_Outlook() Goto MS_Outlook Dim ol As Object, myItem As Object Automation Code 'Create a Microsoft Outlook session Set ol = CreateObject("outlook.application") 'Create a task Set myItem = ol.CreateItem(olTaskItem) 'Add information to the new task With myItem .Subject = "New VBA task" .Body = "This task was created via Automation from Microsoft Excel" .NoAging = True .Close (olSave) End With 'Remove object from memory Set ol = Nothing End Sub

MS_Access mation Code

S_Outlook

ADO-ActiveX Data Objects
ActiveX Data Objects (ADO) allow direct manipulation of a database. Several examples that illustrate common database tasks are included with this workbook.

Retrieve Data via ISAM Drivers This example retrives data from a dBase file, and places the result in a new G worksheet. For this example, you must have the Microsoft dBase driver installed. You must also have the Customer.dbf file installed.

Sub RetrieveISAMdata() G ''' NOTE: This subroutine requires that you reference the '' latest version of the following library: ''' '' Microsoft ActiveX Data Objects Library Dim Dim Dim Dim Dim conn As ADODB.Connection rst As ADODB.Recordset NewBook As Workbook PathToDatabase As String i As Integer

Goto Retrieve ISAM Data Example Sample Code

' Create the Connection object. Set conn = New ADODB.Connection ' Set Database path string PathToDatabase = Application.Path & "\" & _ Application.LanguageSettings.LanguageID(msoLanguageIDInstall) With conn 'Assign the connection string to the connection object. .ConnectionString = "DRIVER={Microsoft dBase Driver (*.dbf)};" & _ "DBQ=" & PathToDatabase & ";" & _ "DefaultDir=" & PathToDatabase & "\" ' Open the connection. .Open strConn End With ' Create a new Recordset Object. Set rst = New ADODB.Recordset With rst ' Connect this recordset to the previously opened connection. .ActiveConnection = conn ' Retrieve all records from the Customer table. .Open "SELECT * FROM customer"

End With ' Add a new worksheet to this workbook Set NewBook = Workbooks.Add ' Loop through all of the fields, returning the field names to the worksheet. For i = 0 To rst.Fields.Count - 1 NewBook.Sheets(1).Range("a1").Offset(0, i).Value = rst.Fields(i).Name Next i ' Copy the recordset to the new worksheet. NewBook.Sheets(1).Range("a2").CopyFromRecordset rst ' Close the recordset. Set rst = Nothing ' Close the Connection. conn.Close End Sub Retrieving Data From Microsoft Access This example uses ADO to create a query based on two tables in the Northwind.mdb database. This example requires that the Northwind.mdb file is installed on your computer. Sub RetrieveAccessData() ''' NOTE: This subroutine requires that you reference the '' latest version of the following library: ''' '' Microsoft ActiveX Data Objects Library Dim Dim Dim Dim Dim conn As ADODB.Connection rst As ADODB.Recordset Nsql As String, Njoin As String, Ncriteria As String NewBook As Workbook i As Integer

Goto Retrieve Access Data Example Sample Code

' Create the Connection object. Set conn = New ADODB.Connection With conn ' Set the OleDB provider for the connection. .Provider = "Microsoft.JET.OLEDB.4.0" ' Open a connection to Northwind.mdb. .Open Application.Path & "\samples\northwind.mdb" End With

Nsql = "SELECT DISTINCTROW Categories.CategoryName, Products.ProductName, Products.Quanti Njoin = "FROM Categories INNER JOIN Products ON Categories.CategoryID = Products.Category Ncriteria = "WHERE ((([Products].Discontinued)=No) AND (([Products].UnitsInStock)>20));" ' Create a new Recordset Object.

Set rst = New ADODB.Recordset With rst ' Connect this recordset to the previously opened connection. .ActiveConnection = conn ' Retrieve all records from the Customer table. .Open Nsql & Njoin & Ncriteria, conn, adOpenDynamic, adLockBatchOptimistic End With ' Add a new worksheet to this workbook Set NewBook = Workbooks.Add ' Loop through all of the fields, returning the field names to the worksheet. For i = 0 To rst.Fields.Count - 1 NewBook.Sheets(1).Range("a1").Offset(0, i).Value = rst.Fields(i).Name Next i ' Copy the recordset to the new worksheet. NewBook.Sheets(1).Range("a2").CopyFromRecordset rst ' Close the recordset. Set rst = Nothing ' Close the Connection. conn.Close End Sub List Tables in a Database This example lists the tables in the Microsoft Access database Northwind.mdb. This example requires that the Northwind.mdb file is installed on your computer. Sub ListTables() ''' NOTE: This subroutine requires that you reference the '' latest version of the following library: ''' '' Microsoft ActiveX Data Objects Library Dim conn As ADODB.Connection Dim rst As ADODB.Recordset ' Create the Connection object. Set conn = New ADODB.Connection With conn ' Set the OleDB provider for the connection. .Provider = "Microsoft.JET.OLEDB.4.0" ' Open a connection to Northwind.mdb. .Open Application.Path & "\samples\northwind.mdb" End With Set rst = conn.OpenSchema(adSchemaTables)

Goto List Tables Example Sample Code

While Not rst.EOF If rst.Fields("TABLE_TYPE") <> "VIEW" Then MsgBox rst.Fields("TABLE_NAME") End If rst.MoveNext Wend Set rst = Nothing conn.Close End Sub List Fields in a Table This example lists the fileds in the Customer.dbf dBase file. For this example, you must have the Microsoft dBase driver installed. You must also have the Customer.dbf file installed. Sub ListFields() ''' NOTE: This subroutine requires that you reference the '' latest version of the following library: ''' '' Microsoft ActiveX Data Objects Library Dim conn As ADODB.Connection Dim rst As ADODB.Recordset Dim fld As ADODB.Field ' Create the Connection object. Set conn = New ADODB.Connection With conn ' Set the OleDB provider for the connection. .Provider = "Microsoft.JET.OLEDB.4.0" ' Open a connection to Northwind.mdb. .Open Application.Path & "\samples\northwind.mdb" End With Set rst = New ADODB.Recordset With rst .ActiveConnection = conn .Open "SELECT * FROM customers" End With For Each fld In rst.Fields MsgBox fld.Name Next fld Set rst = Nothing conn.Close End Sub

Goto List Fields Example Sample Code

Add Data to a New Table in an Access Database This example adds a new table to the Northwind.mdb database. The subroutine then populates the table with data located in cells S1:V30 of this worksheet. This example requires that the Northwind.mdb file is installed on your computer. Sub CreateTable() ''' NOTE: This subroutine requires that you reference the '' latest version of the following library: ''' '' Microsoft ActiveX Data Objects Library ''' Microsoft ADO Ext. 2.1 for DDL and Security ' The first four Dim lines are simultaneously declaring and ' creating new objects. You can use this syntax, or you can ' use the Set statement to create the objects. Dim cat As New ADOX.Catalog Dim tbl As New ADOX.Table Dim conn As New ADODB.Connection Dim rst As New ADODB.Recordset Dim looprange As Range Dim currcell As Range With conn ' Set the OleDB provider for the connection. .Provider = "Microsoft.JET.OLEDB.4.0" ' Open a connection to Northwind.mdb. .Open Application.Path & "\samples\northwind.mdb" End With ' Set the active connection for the Catalog object. cat.ActiveConnection = conn With tbl ' Name the new table. .Name = "SalesTable" ' Name the columns for the new table. With .Columns .Append "Name" .Append "Region" .Append "Product" ' The Sales column must be the Currency data type. .Append "Sales", adCurrency End With End With

Goto Create Table Example Sample Code

' Add the table to the database. cat.Tables.Append tbl With rst .ActiveConnection = conn ' Open the new table. The LockType argument of the ' Open method must be set to adLockOptimistic in order ' add records to the table. .Open "SalesTable", LockType:=adLockOptimistic End With ' Set the range that contains the records to add to the database. Set looprange = Range("s2", Range("s2").End(xlDown)) ' Loop through the information on the worksheet. For Each currcell In looprange With rst ' Add a new record. .AddNew ' Add information to the correct fields. .Fields("Name").Value = currcell.Value .Fields("Region").Value = currcell.Offset(0, 1).Value .Fields("Product").Value = currcell.Offset(0, 2).Value .Fields("Sales").Value = currcell.Offset(0, 3).Value ' Write the new record to the database. .Update End With Next currcell rst.Close Set tbl = Nothing Set cat = Nothing conn.Close End Sub Trapping ADO Errors This example illustrates how to trap, then return relevant information about an error that you may receive when running ADO code.

Sub Trap_ADO_Errors() ''' NOTE: This subroutine requires that you reference the '' latest version of the following library: ''' '' Microsoft ActiveX Data Objects Library Dim conn As ADODB.Connection Dim tbar As String, msg As String

Goto Trap ADO Errors Example Sample Code

' Go to the section labeled "ErrorHandler:" when an ' error occurs. On Error GoTo ErrorHandler ' Create the Connection object. Set conn = New ADODB.Connection With conn ' Set the OleDB provider for the connection. .Provider = "Microsoft.JET.OLEDB.4.0" ' Open a connection to abc.mdb. .Open "C:\abc.mdb" End With ' Exit the subroutine if no error are encountered. Exit Sub ErrorHandler: ' Refer to the Errors collection of the Connection ' object. With conn.Errors(0) ' The title bar will contain the source of the ' error. tbar = .Source ' The message will contain the error number and ' the text of the error message. msg = "Error Number: " & .Number & _ WorksheetFunction.Rept(Chr(13), 2) & _ .Description ' Display the error information. MsgBox prompt:=msg, Title:=tbar End With End Sub

Please Do Not Modify this table. It is necessary for examples contained in this workbook.

oto Retrieve ISAM Data Example Sample Code

oto Retrieve Access Data Example Sample Code

ame, Products.QuantityPerUnit, Products.UnitPrice " = Products.CategoryID " nitsInStock)>20));"

oto List Tables Example Sample Code

oto List Fields Example Sample Code

oto Create Table Example Sample Code

oto Trap ADO Errors Example Sample Code

Name Tom Tom Tom Tom Mike Mike Mike Mike Lindy Lindy Lindy Lindy Jan Jan Jan Jan Harvey Harvey Harvey Harvey Greg Greg Greg Greg Andy Andy Andy Andy

Region East East East East South South South South South South South South East East East East South South South South North North North North North North North North

Product Apples Bananas Pears Oranges Bananas Oranges Apples Pears Apples Pears Oranges Bananas Bananas Apples Pears Oranges Oranges Bananas Apples Pears Pears Oranges Bananas Apples Pears Oranges Bananas Apples

Sales $759 $707 $188 $121 $689 $345 $244 $962 $732 $908 $755 $30 $979 $123 $21 $799 $244 $516 $562 $190 $300 $704 $785 $527 $513 $800 $138 $430


				
DOCUMENT INFO
Shared By:
Categories:
Tags:
Stats:
views:181
posted:5/31/2009
language:English
pages:49