Using the OLE Container Control with Excel


The first time we used the OLE container control with Excel, we were amazed to see all the cool things we could include in our program. We found ourselves doing things that we never dreamed one person could do. What's more, we saw VB and Excel handle these incredibly difficult tasks with the greatest of ease. After seeing this section's code example at work, you will appreciate the power these two objects possess.

The sample program in this section is an MDI application that presents information from Excel in chart and table form. By using tabs, the user can switch between the two views shown in Figure 26.1 and .

FIG. 26.1

Using the OLE Container control, you can view data in a chart.

FIG. 26.2

By adding tabs, you can switch from the chart to the data.

It is a good programming practice to build a set of "helper functions" for use with large-scale applications. contains code that must be accessible to two or more modules in the project at runtime. Placing this code in a separate module prevents your having to maintain the identical code in several modules.

Listing 26.2 - PUBLIC.BAS - Shared Procedures and Declarations Should Be Stored in Modules


'*********************************************************************
' PUBLIC.BAS - Global constants, functions, and variables
'*********************************************************************
Option Explicit
'*********************************************************************
' API Declarations for this module
'*********************************************************************
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
   (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
Private Declare Function PostMessage Lib "user32" Alias _
   "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal _
   wParam As Long, lParam As Any) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd&, _
   ByVal nCmdShow As Long) As Long
'*********************************************************************
' This global keeps track of the new instances of frmExcel
'*********************************************************************
Public gintXLInstances As Integer
'*********************************************************************
' Creates a new instance of frmExcel
'*********************************************************************
Public Sub CreateNewWindow()
   Dim objExcel As New frmExcel
   '*****************************************************************
   ' Avoid showing your newly created form until you are finished
   ' making changes to it
   '*****************************************************************
   With objExcel
       .Caption = .Caption & " - " & CStr(Forms.Count - 1)
       .Visible = True
   End With
End Sub
'*********************************************************************
' Generic update status bar routine.
'*********************************************************************
Public Sub UpdateStatus(lblStatusBar As Label, _
                       Optional strStatusText As String = "Ready")
   lblStatusBar = strStatusText
End Sub
'*********************************************************************
' Start a OLE Server, if it is not already running
'*********************************************************************
Public Function StartServer(strClassName$, strProgram$) As Long
   Const SW_SHOWNA = 8
   Dim hWnd As Long
   '*****************************************************************
   ' Prevent any error messages from interrupting the program
   '*****************************************************************
   On Error Resume Next
   '*****************************************************************
   ' Check to see if its already running. If so, then activate it
   '*****************************************************************
   hWnd = FindWindow(strClassName, 0&)
   
   If hWnd Then
       ShowWindow hWnd, SW_SHOWNA
       '*************************************************************
       ' Return False to indicate that it was already running
       '*************************************************************
       StartServer = False
   Else
       '*************************************************************
       ' Otherwise, start it and return its hWnd
       '*************************************************************
       Shell strProgram, vbMinimizedNoFocus
       DoEvents
       StartServer = FindWindow(strClassName, 0&)
   End If
End Function
'*********************************************************************
' Posts a WM_CLOSE message to an application
'*********************************************************************
Public Sub CloseApp(hWnd As Long)
   Const WM_CLOSE = &H10
   PostMessage hWnd, WM_CLOSE, 0, 0&
End Sub

contains the minimum amount of code needed to display the splash screen.

This form (Figure 26.3) gives the user "visual candy" during long processing times. A splash screen reassures users that their system has not locked up during heavy processing.

FIG. 26.3

Splash screens give users "visual candy" during lengthy operations.

Listing 2.3 - SPLASH.FRM - Splash Screens Help Calm Users' Fears that Your Application Has Locked Up


'*********************************************************************
' FRMSPLASH - This is just a splash form that is used to display
'             messages to the user during long processes.
'*********************************************************************
Option Explicit
'*********************************************************************
' Declare SetWindowPos so this window can be "AlwaysOnTop".
'*********************************************************************
Private Declare Sub SetWindowPos Lib "user32" (ByVal hWnd As Long, _
   ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, _
   ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
'*********************************************************************
' Initialize the form.
'*********************************************************************
Private Sub Form_Load()
   Const HWND_TOPMOST = -1
   Const SWP_NOMOVE = 2
   Const SWP_NOSIZE = 1
   Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
   '*****************************************************************
   ' Set the mouse pointer.
   '*****************************************************************
   Screen.MousePointer = vbHourglass
   '*****************************************************************
   ' Set the window to TopMost, and ignore the return value.
   '*****************************************************************
   SetWindowPos hWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS
   '*****************************************************************
   ' Reposition the label to the center of the form.
   '*****************************************************************
   lblMessage.Move (ScaleWidth - lblMessage.Width) / 2, _
                   (ScaleHeight - lblMessage.Height) / 2
End Sub
'*********************************************************************
' Restore the mouse pointer.
'*********************************************************************
Private Sub Form_Unload(Cancel As Integer)
   Screen.MousePointer = vbDefault
End Sub

contains code to size frmSplash and its command button. This form displays information, gathered through OLE Automation, about the linked OLE object in this application (see Figure 26.4).

FIG. 26.4

The Object Information dialog box displays data gathered via OLE Automation using the control's Object property.

Listing 26.4 - INFO.FRM - Information Dialog Boxes Should Contain Little to No Code


'*********************************************************************
' FRMINFO.FRM - This is essentially a "stupid" dialog used by
'               frmExcel. Its only purpose is to display information.
'*********************************************************************
Option Explicit
'*********************************************************************
' Initialize the form so that it can hold 10, 40 char lines.
'*********************************************************************
Private Sub Form_Load()
   '*****************************************************************
   ' Get the height and width of a character to set the form size.
   '*****************************************************************
   Width = TextWidth(String(50, "X"))
   Height = TextHeight("X") * 14
   '*****************************************************************
   ' Move the command button to the bottom center of the form.
   '*****************************************************************
   With cmd
       .Move (ScaleWidth - .Width) / 2, ScaleHeight - .Height - 10
   End With
End Sub
'*********************************************************************
' Always unload this form, since it loads so fast.
'*********************************************************************
Private Sub cmd_Click()
   Unload Me
End Sub

is the MDI parent. This form contains code that starts Excel, if necessary, and maintains the toolbar and the status bar (see Figure 26.5). You develop the toolbar and status bar, shown in Figure 26.5, entirely in Visual Basic by using picture boxes and image controls. You use no custom controls, so your application loads faster and your distribution disk is smaller. This is important when you are writing large applications, because every control in your project increases the startup time.

FIG. 26.5

The MDI form contains only a minimal menu, a toolbar, and status bar.

Listing 26.5 - MDIOLE.FRM - An MDI Form Should Only Manage Itself and Load the First Child Form


'*********************************************************************
' MDIOLE.FRM - MDI Parent Form.
'*********************************************************************
Option Explicit
Private mlngStartedExcel As Long
'*********************************************************************
' Saves the button image in imgHold, and inserts the down picture.
'*********************************************************************
Private Sub imgTools_MouseDown(Index As Integer, Button As Integer, _
                          Shift As Integer, X As Single, Y As Single)
   imgHold.Picture = imgTools(Index).Picture
   imgTools(Index).Picture = imgTools(Index + 1).Picture
End Sub
'*********************************************************************
' Updates the status bar.
'*********************************************************************
Private Sub imgTools_MouseMove(Index As Integer, Button As Integer, _
                          Shift As Integer, X As Single, Y As Single)
   UpdateStatus lblStatus, imgTools(Index).Tag
End Sub
'*********************************************************************
' Restores the graphic, and processes toolbar clicks.
'*********************************************************************
Private Sub imgTools_MouseUp(Index As Integer, Button As Integer, _
                        Shift As Integer, X As Single, Y As Single)
   '*****************************************************************
   ' Restore the toolbar picture.
   '*****************************************************************
   imgTools(Index).Picture = imgHold.Picture
   '*****************************************************************
   ' Execute the appropriate toolbar action.
   '*****************************************************************
Select Case Index
   Case 0 ' Hand
       Unload Me
   Case 2 ' Question Mark
       '*************************************************************
       ' Bring up the splash form again, because the first OLE
       ' Automation call will require Excel to be started. After
       ' it is started, any subsequent calls will be performed
       ' as fast as they would be in a native Excel macro.
       '*************************************************************
       frmSplash.lblMessage = _
       "Gathering OLE Automation information from Excel...Please Wait!"
       frmSplash.Show
       frmSplash.Refresh
       '*************************************************************
       ' Load the info dialog, and start printing to it.
       '*************************************************************
       Load frmInfo
       '*************************************************************
       ' NOTE: 

Using the OLE Container's Object property, you can ' execute OLE Automation statements on the object in ' the control. '************************************************************* ' Cache a couple helpful object to prevent unnecessary OLE ' automation lookups. '************************************************************* Dim objExcelSheet As Object, objExcelApp As Object Dim objExcelWorkbook As Object '************************************************************* ' Although the Class property contains Excel.Sheet, beginning ' with Excel 97, all embedded Excel objects are now Workbooks. ' Since we will be making multiple calls to the Workbook ' object, we will cache this variable. '************************************************************* Set objExcelWorkbook = ActiveForm.Excel(0).Object '************************************************************* ' We will also be making a few calls to the worksheet object, ' so we should cache it to by retrieving a pointer to the ' active worksheet via the ActiveSheet method of the workbook ' object. '************************************************************* Set objExcelSheet = objExcelWorkbook.ActiveSheet '************************************************************* ' Query Excel for the information and send the results off ' to a helper function that will print the results to a ' form. '************************************************************* With objExcelSheet.Application PrintMessage "Application Name:", _ .Name & " " & _ .Version PrintMessage "Operating System:", _ .OperatingSystem PrintMessage "Organization Name:", _ .OrganizationName End With PrintMessage "Range(""A2""):", _ objExcelSheet.Range("A2") PrintMessage "Read Only:", _ objExcelWorkbook.ReadOnly PrintMessage "Saved:", _ objExcelWorkbook.Saved PrintMessage "Sheet Name:", _ objExcelSheet.Name PrintMessage "Workbook Author:", _ objExcelWorkbook.Author PrintMessage "Workbook Name:", _ objExcelWorkbook.Name '************************************************************* ' Make sure all activity is complete, before unloading the ' the splash. '************************************************************* DoEvents Unload frmSplash '************************************************************* ' Display the information to the user. '************************************************************* frmInfo.Show vbModal End Select End Sub '********************************************************************* ' Print the formatted string to frmInfo. '********************************************************************* Private Sub PrintMessage(strItem As String, varResult As Variant) Dim strLeft As String * 20, strRight As String * 30 strLeft = strItem strRight = varResult frmInfo.Print strLeft & strRight End Sub '********************************************************************* ' Prepares the application for use. '********************************************************************* Private Sub MDIForm_Load() Dim strXLClassID As String, strXLPath As String '***************************************************************** ' Always use the system defined backcolor. '***************************************************************** BackColor = vb3DFace picStatusBar.BackColor = vb3DFace Toolbar.BackColor = vb3DFace '***************************************************************** ' Lookup the location of Excel in the registry by getting its ' class id (a GUID) and then finding that GUID in the CLSID ' section. Once you've found it, then just take the default ' value from the LocalServer (or LocalServer32) entry. '***************************************************************** strXLClassID = GetRegString(HKEY_CLASSES_ROOT, "Excel.Sheet\CLSID", "") strXLPath = GetRegString(HKEY_CLASSES_ROOT, _ "CLSID\" & strXLClassID & "\LocalServer", "") '***************************************************************** ' If necessary, start Excel to prevent annoying message boxes. '***************************************************************** mlngStartedExcel = StartServer("XLMAIN", strXLPath) WindowState = vbMaximized CreateNewWindow Arrange vbTileHorizontal End Sub '********************************************************************* ' Updates the status bar with the default text. '********************************************************************* Private Sub MDIForm_MouseMove(Button As Integer, Shift As Integer, _ X As Single, Y As Single) UpdateStatus lblStatus End Sub '********************************************************************* ' If you had to start Excel, then close it. Otherwise, leave it alone. '********************************************************************* Private Sub MDIForm_Unload(Cancel As Integer) If mlngStartedExcel Then CloseApp mlngStartedExcel End Sub '********************************************************************* ' Terminates the application. '********************************************************************* Private Sub mnuFileItems_Click(Index As Integer) Unload Me End Sub '********************************************************************* ' Updates the status bar with the default text. '********************************************************************* Private Sub StatusBar_MouseMove(Button As Integer, Shift As Integer, _ X As Single, Y As Single) UpdateStatus lblStatus End Sub '********************************************************************* ' Adds a 3D appearance to the status bar. '********************************************************************* Private Sub picStatusBar_Paint() HighlightBar picStatusBar Highlight picStatusBar, lblStatus End Sub '********************************************************************* ' Updates the status bar with the default text. '********************************************************************* Private Sub Toolbar_MouseMove(Button As Integer, Shift As Integer, _ X As Single, Y As Single) UpdateStatus lblStatus End Sub '********************************************************************* ' Adds a 3D appearance to the toolbar. '********************************************************************* Private Sub Toolbar_Paint() HighlightBar Toolbar End Sub '********************************************************************* ' Adds a 3D effect to a picture box. '********************************************************************* Private Sub HighlightBar(picBar As PictureBox) With picBar picBar.Line (0, 5)-(.ScaleWidth, 5), vb3DHighlight picBar.Line (0, .ScaleHeight - 15)-(.ScaleWidth, _ .ScaleHeight - 15), vb3DShadow End With End Sub '********************************************************************* ' Adds a 3D border around a control. '********************************************************************* Private Sub Highlight(ctlSurface As Control, ctlSource As Control) Const HORIZONTAL_OFFSET = 50 Const VERTICAL_OFFSET = 70 With ctlSource '************************************************************* ' Top '************************************************************* ctlSurface.Line (.Left - HORIZONTAL_OFFSET, .Top - _ HORIZONTAL_OFFSET)-(.Width, .Top - HORIZONTAL_OFFSET), _ vb3DShadow '************************************************************* ' Left '************************************************************* ctlSurface.Line (.Left - HORIZONTAL_OFFSET, .Top - _ HORIZONTAL_OFFSET)-(.Left - HORIZONTAL_OFFSET, .Height _ + VERTICAL_OFFSET), vb3DShadow '************************************************************* ' Bottom '************************************************************* ctlSurface.Line (.Left - HORIZONTAL_OFFSET, .Height + _ VERTICAL_OFFSET)-(.Width, .Height + VERTICAL_OFFSET), _ vb3DHighlight '************************************************************* ' Right '************************************************************* ctlSurface.Line (.Width, .Top - HORIZONTAL_OFFSET)-(.Width, _ .Height + VERTICAL_OFFSET + 15), vb3DHighlight End With End Sub

is the child form. This form is the heart of the application, because it contains all the code necessary to display the data and tabs. It also keeps the status bar up to date when the user moves the mouse around the screen.

Listing 26.6 - EXCEL.FRM - In an MDI Application, Most Code Should Reside in the Child Form


'*********************************************************************
' EXCEL.FRM - MDI Child form with a OLE container control.
'*********************************************************************
Option Explicit
'*********************************************************************
' The RECT and GetClientRect decs are required for PositionFrame.
'*********************************************************************
Private Type RECT
   rLEFT As Long
   rTOP As Long
   rWIDTH As Long
   rHEIGHT As Long
End Type
Private Declare Sub GetClientRect Lib "user32" (ByVal hWnd As Long, _
   lpRect As RECT)
'*********************************************************************
' Gets the client area of a frame, and sizes an object to it.
'*********************************************************************
Private Sub PositionFrame(fraSource As Frame, ctlChild As Control)
Dim Client As RECT, X As RECT
   GetClientRect fraSource.hWnd, Client
   With Client
       X.rLEFT = (.rLEFT * Screen.TwipsPerPixelX) + 50
       X.rTOP = (.rTOP * Screen.TwipsPerPixelY) + 150
       X.rWIDTH = (.rWIDTH * Screen.TwipsPerPixelX) - 90
       X.rHEIGHT = (.rHEIGHT * Screen.TwipsPerPixelY) - 190
   End With
   ScaleMode = vbTwips
   ctlChild.Move X.rLEFT, X.rTOP, X.rWIDTH, X.rHEIGHT
   ScaleMode = vbPixels
End Sub
'*********************************************************************
' Forces Excel to be the topmost window when you double-click.
'*********************************************************************
Private Sub Excel_DblClick(Index As Integer)
   Excel(Index).Object.Application.Visible = True
End Sub
'*********************************************************************
' Initializes this form instance. This code is also called every time
' a new form is created.
'*********************************************************************
Private Sub Form_Load()
   '*****************************************************************
   ' Establishing links takes a few minutes, so give the user
   ' something to look at.
   '*****************************************************************
   With frmSplash
       .lblMessage = "Establishing links with Excel...Please Wait."
       .Show
       .Refresh
   End With
   '*****************************************************************
   ' Always create your recreate links in case the program has been
   ' moved. In a real program, you should NEVER hard-code your links.
   '*****************************************************************
   Excel(0).CreateLink App.Path & "\" & "SAMPLE.XLS!R1C1:R5C5"
   Excel(1).CreateLink App.Path & "\" & "SAMPLE.XLS!Pie"
   '*****************************************************************
   ' Call DoEvents to process the links, and to prevent the splash
   ' screen from disappearing prematurely.
   '*****************************************************************
   DoEvents
   Unload frmSplash
End Sub
'*********************************************************************
' Updates the status bar with the default text.
'*********************************************************************
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, _
                                            X As Single, Y As Single)
   UpdateStatus mdiOLE.lblStatus
End Sub
'*********************************************************************
' This procedure controls the tab redrawing to handle switching.
'*********************************************************************
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, _
                                           X As Single, Y As Single)
   Dim intRes As Integer
   intRes = Abs(DrawTabs(Me, X, Y) - 1)
   If intRes < 2 Then Tabs(intRes).ZOrder
End Sub
'*********************************************************************
' Repositon the frames and resize the tabs.
'*********************************************************************
Private Sub Form_Resize()
   Dim sngActivateTab As Single
   '*****************************************************************
   ' When the form is resized, the tabs must be rescaled to fit.
   '*****************************************************************
   SetupTabs Me, 2
   '*****************************************************************
   ' Position the OLE Containers to fit inside the frames.
   '*****************************************************************
   PositionFrame Tabs(0), Excel(0)
   PositionFrame Tabs(1), Excel(1)
   '*****************************************************************
   ' SetupTabs will make the first tab active. Determine which
   ' tab should be active, and send it a MouseUp event.
   '*****************************************************************
   sngActivateTab = IIf(gintXLInstances = 0, 10, _
                    ((ScaleWidth - 2) / 2) + 100)
   Form_MouseUp 0, 0, sngActivateTab, 20
End Sub
'*********************************************************************
' The following code demonstrates how to close a workbook without
' being prompted to save the changes.
'*********************************************************************
Private Sub Form_Unload(Cancel As Integer)
   Excel(0).Object.Saved = True
End Sub
'*********************************************************************
' Handles clicks from the File Submenu.
'*********************************************************************
Private Sub mnuFileItems_Click(Index As Integer)
   On Error Resume Next
   Select Case Index
       Case 1 'New
           CreateNewWindow
       Case 3 'Exit
           Unload mdiOLE
   End Select
End Sub
'*********************************************************************
' Handles clicks from the Object Submenu.
'*********************************************************************
Private Sub mnuObjectItems_Click(Index As Integer)
   Select Case Index
       Case 1 'Update Links
           Excel(0).Update
           Excel(1).Update
       Case 2 'Close Object
           Excel(gintXLInstances).Close
   End Select
End Sub
'*********************************************************************
' Updates the status bar.
'*********************************************************************
Private Sub Excel_MouseMove(Index As Integer, Button As Integer, _
                          Shift As Integer, X As Single, Y As Single)
   UpdateStatus mdiOLE.lblStatus, Excel(Index).Tag
End Sub
'*********************************************************************
' Handles clicks from the Window Submenu.
'*********************************************************************
Private Sub mnuWindowItems_Click(Index As Integer)
   mdiOLE.Arrange Index - 1
End Sub
'*********************************************************************
' Set the gintXLInstances. This isn't foolproof, but it works for this
' demonstration. In the "real world," this wouldn't be enough.
'*********************************************************************
Private Sub Tabs_MouseMove(Index As Integer, Button As Integer, _
                          Shift As Integer, X As Single, Y As Single)
   gintXLInstances = Index
End Sub

In addition to all the code and forms in Visual Basic, the XLCONT.VBP project also includes some code inside Excel that enables the user to return to your application. includes the essential Excel macros.

Listing 26.7 - SAMPLE.XLS - Supporting Code in Excel Can Help in Two-Way Communication Between Your Applications


'*****************************************************************
' Returns control to your VB Program, and minimizes Excel.
'*****************************************************************
Sub ReturnToExample()
   On Error Resume Next
   AppActivate Title:="OLE Container Control Example"
   If Err Then MsgBox "The example program isn't open.", _
          vbInformation
   Application.WindowState = xlMinimized
End Sub

The ReturnToExample() procedure enables you to add a macro button to the worksheet, as shown in Figure 26.6. Such a button clearly shows users what they must do in order to return to your application. In addition, you can modify your menus (see Figure 26.7) to prevent users from closing the file or Excel. Notice how the Exit menu item has been removed.

FIG. 26.6

When using linked objects, you usually should give the user a viable way to return to your application.

FIG. 26.7

Modifying Excel's menus can help ensure that users can't do anything they shouldn't.