XPost: comp.lang.basic.visual   
   From: otie_nospam@adelphia.net   
      
   Here's my solution, in case it helps anyone:   
      
   Public Sub Copy_Data_to_Excel()   
       Dim x1%, y1%   
       Dim current_col%, current_row%   
       Dim xls_filename$, active_sheet_name$   
      
           Dim MyXL As Object      ' Variable to hold reference to   
   Microsoft Excel.   
           Dim ExcelWasNotRunning As Boolean       ' Flag for final   
   release.   
           Dim mySheet As Excel.Worksheet   
      
           'test to see if there is a copy of Microsoft Excel already   
   running.   
           On Error Resume Next    ' Defer error trapping.   
      
           'getobject function called without the first argument returns   
   a reference to an instance   
           'of the application. If the application isn't running, an   
   error occurs.   
           Set MyXL = GetObject(, "Excel.Application")   
           If Err.Number <> 0 Then   
               ExcelWasNotRunning = True   
               MsgBox "Please open an Excel spreadsheet before performing   
   this operation", vbCritical, "No spreadsheet open"   
               Set mySheet = Nothing   
               Set MyXL = Nothing   
               Exit Sub   
           End If   
      
           Err.Clear   ' Clear Err object in case error occurred.   
      
           'check for Microsoft Excel. If Microsoft Excel is running,   
   enter it into the Running Object table.   
           Call DetectExcel   
      
           xls_filename$ = MyXL.Application.ActiveWindow.Parent.FullName   
   'full name of .xls file   
           active_sheet_name$ = MyXL.Application.ActiveSheet.Name   
   'active sheet within that file   
      
           'set the object variable to reference the file you want to   
   see.   
           Set MyXL = GetObject(xls_filename$)   
      
           Set mySheet = MyXL.Worksheets(active_sheet_name$)   
      
           'show Microsoft Excel through its Application property. Then   
   show the actual window   
           'containing the file using the Windows collection of the MyXL   
   object reference.   
           MyXL.Application.Visible = True   
           MyXL.Parent.Windows(1).Visible = True   
      
           'get active cell - this is where program will start to copy   
   data   
           current_col% = MyXL.Application.ActiveCell.Column - 1   
           current_row% = MyXL.Application.ActiveCell.row - 1   
      
           'set column width   
           mySheet.Columns(5 + current_col%).ColumnWidth = 15      '15 =   
   number of characters   
      
           'set centering   
           mySheet.Columns(2 + current_col%).HorizontalAlignment =   
   xlCenter   
           mySheet.Columns(3 + current_col%).HorizontalAlignment =   
   xlCenter   
           mySheet.Columns(4 + current_col%).HorizontalAlignment =   
   xlCenter   
           mySheet.Columns(5 + current_col%).HorizontalAlignment =   
   xlCenter   
           mySheet.Columns(6 + current_col%).HorizontalAlignment =   
   xlCenter   
           mySheet.Columns(7 + current_col%).HorizontalAlignment =   
   xlCenter   
      
           'set number of digits to the right of the decimal point   
           Data_Grid!grdOutput.col = 1   
           Data_Grid!grdOutput.row = 1   
           If IsNumeric(Data_Grid!grdOutput.Text) Then   
               If conversion_factor <= 180 Then   
                   mySheet.Columns(2 + current_col%).NumberFormat =   
   "0.00"   
               Else   
                   mySheet.Columns(2 + current_col%).NumberFormat = "0.0"   
               End If   
           End If   
      
           'set the format for date and time stamp   
           Data_Grid!grdOutput.col = 4   
           Data_Grid!grdOutput.row = 1   
           If IsDate(Data_Grid!grdOutput.Text) Then   
               mySheet.Columns(5 + current_col%).NumberFormat = "dd mmm   
   yyyy hh:mm"   
           End If   
      
           'copy data - each column, then each row   
           For y1% = 1 To Data_Grid!grdOutput.Rows - 1   
               For x1% = 0 To 6            '7 columns of data total   
                   Data_Grid!grdOutput.col = x1%   
                   Data_Grid!grdOutput.row = y1%   
      
                   mySheet.Cells(y1% + current_row%, x1% + 1 +   
   current_col%).Font.Name = "Rosecast"   
                   mySheet.Cells(y1% + current_row%, x1% + 1 +   
   current_col%).Font.Size = 10   
                   mySheet.Cells(y1% + current_row%, x1% + 1 +   
   current_col%).Font.Color = RGB(0, 0, 0)   
      
                   If x1% = 1 Or x1% = 3 Then   
                       If Data_Grid!grdOutput.CellForeColor = RGB(0, 192,   
   0) Then   
                           mySheet.Cells(y1% + current_row%, x1% + 1 +   
   current_col%).Font.Color = RGB(0, 192, 0)   
                       ElseIf Data_Grid!grdOutput.CellForeColor =   
   QBColor(9) Then   
                           mySheet.Cells(y1% + current_row%, x1% + 1 +   
   current_col%).Font.Color = RGB(0, 0, 255)   
                       ElseIf Data_Grid!grdOutput.CellForeColor =   
   QBColor(12) Then   
                           mySheet.Cells(y1% + current_row%, x1% + 1 +   
   current_col%).Font.Color = RGB(255, 0, 0)   
                       End If   
                   End If   
      
                   mySheet.Cells(y1% + current_row%, x1% + 1 +   
   current_col%).Value = Data_Grid!grdOutput.Text   
               Next x1%   
           Next y1%   
   'done   
      
           'if this copy of Microsoft Excel was not running when you   
   started, close it using the Application property's Quit method.   
           'note that when you try to quit Microsoft Excel, the title bar   
   blinks and a message is displayed asking if you   
           'want to save any loaded files.   
           If ExcelWasNotRunning = True Then   
               MyXL.Application.Quit   
           End If   
      
           Set mySheet = Nothing       'release resources   
           Set MyXL = Nothing   
   End Sub   
      
      
   Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal   
   lpClassName As String, ByVal lpWindowName As Long) As Long   
      
      
   Public Sub DetectExcel()   
   'This procedure detects a running Excel application and registers it.   
       Const WM_USER = 1024   
       Dim hWnd As Long   
      
   'If Excel is running, then this API call returns its handle.   
       hWnd = FindWindow("XLMAIN", 0)   
      
       If hWnd = 0 Then   
           '0 means Excel not running.   
           Exit Sub   
       Else   
           'Excel is running so use the SendMessage API function to enter   
   it in the Running Object Table.   
           SendMessage hWnd, WM_USER + 18, 0, 0   
       End If   
   End Sub   
      
      
   ---   
   Allen   
      
   Free astrology software at:   
   http://www.astrowin.org   
      
   "Otie"  wrote in message   
   news:Rp-dnXSlveOhLMveRVn-jQ@adelphia.com...   
   > I found the following under the GetObject help notes and in the   
   > example for GetObject:   
   >   
   > "This example uses the GetObject function to get a reference to a   
   > specific Microsoft Excel worksheet (MyXL). It uses the worksheet's   
   > Application property to make Microsoft Excel visible, to close it,   
   and   
   > so on. Using two API calls, the DetectExcel Sub procedure looks for   
   > Microsoft Excel, and if it is running, enters it in the Running   
   Object   
      
   [continued in next message]   
      
   --- SoupGate-Win32 v1.05   
    * Origin: you cannot sedate... all the things you hate (1:229/2)