VERSION 4.00 Begin VB.Form frmExcel AutoRedraw = -1 'True BackColor = &H00C0C0C0& Caption = "Excel" ClientHeight = 4110 ClientLeft = 1050 ClientTop = 1755 ClientWidth = 7590 Height = 4800 Icon = "frmexcel.frx":0000 Left = 990 LinkTopic = "Form1" MDIChild = -1 'True ScaleHeight = 4110 ScaleWidth = 7590 Top = 1125 Visible = 0 'False Width = 7710 Begin VB.Frame Tabs Caption = "Chart View" Height = 3705 Index = 1 Left = 540 TabIndex = 2 Top = 270 Width = 6900 Begin VB.OLE Excel Class = "Excel.Sheet.5" Height = 3345 Index = 1 Left = 135 SizeMode = 1 'Stretch SourceDoc = "d:\book\submit\chpx4\code\sample.xls" TabIndex = 3 Tag = "Double click to edit this chart in Excel" Top = 270 Width = 6675 End End Begin VB.Frame Tabs Caption = "Data View" Height = 3705 Index = 0 Left = 45 TabIndex = 0 Top = 135 Width = 6900 Begin VB.OLE Excel Class = "Excel.Sheet.5" Height = 3345 Index = 0 Left = 90 SourceDoc = "d:\book\submit\chpx4\code\sample.xls" TabIndex = 1 Tag = "Double click to edit this data in Excel" Top = 270 Width = 6720 End End Begin VB.Menu mnuFile Caption = "&File" NegotiatePosition= 1 'Left Begin VB.Menu mnuFileItems Caption = "&New" Index = 1 End Begin VB.Menu mnuFileItems Caption = "-" Index = 2 End Begin VB.Menu mnuFileItems Caption = "E&xit" Index = 3 End End Begin VB.Menu mnuObject Caption = "&Object" NegotiatePosition= 2 'Middle Begin VB.Menu mnuObjectItems Caption = "&Update Links" Index = 1 End Begin VB.Menu mnuObjectItems Caption = "&Close Object" Index = 2 End End Begin VB.Menu mnuWindow Caption = "&Window" NegotiatePosition= 3 'Right WindowList = -1 'True Begin VB.Menu mnuWindowItems Caption = "&Cascade" Index = 1 End Begin VB.Menu mnuWindowItems Caption = "Tile &Horizontal" Index = 2 End Begin VB.Menu mnuWindowItems Caption = "Tile &Vertical" Index = 3 End Begin VB.Menu mnuWindowItems Caption = "&Arrange Icons" Index = 4 End End Attribute VB_Name = "frmExcel" Attribute VB_Creatable = False Attribute VB_Exposed = False '********************************************************************* ' FRMEXCEL.FRM - MDI Child form with a OLE container control. '********************************************************************* Option Explicit '********************************************************************* ' The RECT and GetClientRect decs are required for PositionFrame. '********************************************************************* #If Win32 Then 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) #Else Private Type RECT rLEFT As Integer rTOP As Integer rWIDTH As Integer rHEIGHT As Integer End Type Private Declare Sub GetClientRect Lib "User" (ByVal hWnd As Integer, _ lpRect As RECT) #End If '********************************************************************* ' Gets the client area of a frame, and sizes an object to it. '********************************************************************* Private Sub PositionFrame(SourceFrame As Frame, ChildObject As Control) Dim Client As RECT, X As RECT GetClientRect SourceFrame.hWnd, Client X.rLEFT = (Client.rLEFT * Screen.TwipsPerPixelX) + 50 X.rTOP = (Client.rTOP * Screen.TwipsPerPixelY) + 150 X.rWIDTH = (Client.rWIDTH * Screen.TwipsPerPixelX) - 90 X.rHEIGHT = (Client.rHEIGHT * Screen.TwipsPerPixelY) - 190 ScaleMode = vbTwips ChildObject.Move X.rLEFT, X.rTOP, X.rWIDTH, X.rHEIGHT ScaleMode = vbPixels End Sub '********************************************************************* ' Inializes this form instance. This code is also called everytime ' a new form is created. '********************************************************************* Private Sub Form_Load() '***************************************************************** ' Establishing links takes a few minutes, so give the user ' something to look at. '***************************************************************** frmSplash.lblMessage = "Establishing links with Excel...Please Wait." frmSplash.Show frmSplash.Refresh '***************************************************************** ' Always create your recreate links in case the program has been ' moved. In a real program, you should NEVER hardcode 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 proceedure controls the tab redrawing to handle switching. '********************************************************************* Private Sub Form_MouseUp(Button As Integer, Shift As Integer, _ X As Single, Y As Single) Dim res% res = Abs(DrawTabs(Me, X, Y) - 1) If res < 2 Then Tabs(res).ZOrder End Sub '********************************************************************* ' Repositon the frames and resize the tabs. '********************************************************************* Private Sub Form_Resize() Dim ActivateTab! '***************************************************************** ' 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 MouseUp it. '***************************************************************** ActivateTab = IIf(ActiveIndex = 0, 10, ((ScaleWidth - 2) / 2) + 100) Form_MouseUp 0, 0, ActivateTab, 20 End Sub '********************************************************************* ' Automatically saves any changes to the data. '********************************************************************* Private Sub Form_Unload(Cancel As Integer) Excel(0).Object.Parent.RunAutoMacros (xlAutoClose) 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 If ExcelWindows <= MAX_WINDOWS Then ExcelWindows = ExcelWindows + 1 '***************************************************** ' Create a new form, and set its caption. '***************************************************** Excels(ExcelWindows - 1).Caption = "Excel -" _ & Str$(ExcelWindows + 1) '***************************************************** ' Remove the caption from both frames. '***************************************************** Excels(ExcelWindows - 1).Tabs(0) = "" Excels(ExcelWindows - 1).Tabs(1) = "" End If 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(ActiveIndex).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 ActiveIndex. 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) ActiveIndex = Index End Sub