SELECT ALL1
CALCULATE CNT() TO i0
GO TOP 
WAIT 'Ожидайте. Идёт передача отчёта в Microsoft Excel !' WINDOW NOWAIT AT 20,50               
  PRIVATE XLApp, XLSheet
  LOCAL loBook , loRange
  #DEFINE xlWBATWorksheet -4167
  #DEFINE xlCenter -4108 && и овер много других DEFINE...
                
  XLApp    =  CREATEOBJECT('excel.application')  
  XLApp.VISIBLE    = .F.
  loBook = m.XLApp.workbooks.Add(xlWBATWorksheet)
  XLSheet = m.loBook.Sheets(1)  
  XLApp.ActiveWindow.WINDOWSTATE = xlMaximized && 2 
  XLApp.Caption='Печать выборки по замечаниям на '+DTOC(DATE())+ ' ЧАО Экоэнегрия'
  XLSheet = XLApp.ActiveSheet  
       WITH XLSheet 
        m.XLSheet.Rows(1).NumberFormat = "@"
        m.XLSheet.Rows(1).HorizontalAlignment = xlCenter
               m.XLSheet.Rows(1).VerticalAlignment = xlTop
        m.XLSheet.Rows(1).WrapText = .T.
        m.XLSheet.Rows(1).Font.Bold = .T.   
          .Cells(1,1).Value = " № "       
              .Cells(1,2).Value = "Выдано:"  
        .Cells(1,3).Value = "KKS"      
        .Cells(1,4).Value = "Код"
        .Cells(1,5).Value = "Объект"      
        .Cells(1,6).Value = "Дефект"
        *** еще 4 поля (не важно) ****             
          **** вывести данные ****
          FOR k=1 TO i0
              .Cells(k+1,1).Value= ALL1.NPP
            .Cells(k+1,2).Value= ALL1.ADtVyd
            .Cells(k+1,3).Value= ALL1.kks
            .Cells(k+1,4).Value= ALL1.KodDef
            .Cells(k+1,5).Value= RTRIM(ALL1.ObjName)
                    **** еще аналогичных 5 передач ***
             SKIP 
        ENDFOR 
                      
          *** нарисовать рамку ******
              loRange =m.XLSheet.Range(m.XLSheet.Cells(1,1).Address+":"+m.XLSheet.Cells(i0+1,10).Address)
        loRange.Borders(xlEdgeLeft).Weight = xlThin
        loRange.Borders(xlEdgeTop).Weight = xlThin
        loRange.Borders(xlEdgeBottom).Weight = xlThin
        loRange.Borders(xlEdgeRight).Weight = xlThin
        loRange.Borders(xlInsideVertical).Weight = xlThin
        loRange.Borders(xlInsideHorizontal).Weight = xlThin
      ENDWITH  
           
    XLApp.Cells.Select  
      XLApp.Selection.Columns.AutoFit 
      XLApp.Selection.Font.Size = 8
     XLSheet.RANGE("A1").select  

      ** выделить ячейки на 2 снизу от конца таблицы и объединить ****
      loRange = m.XLSheet.Range(m.XLSheet.Cells(i0+3,3).Address+":"+m.XLSheet.Cells(i0+3,6).Address)
     loRange.WrapText = .F.
     loRange.Orientation = 0
     loRange.MergeCells = .T.
     XLSheet.Cells(i0+3,3).Value= "Статистика замечаний от "+DTOC(DATE())                  

    *** обвести линией ячейки объединенные и с подписями ***
      loRange.Borders(xlEdgeLeft).Weight = xlThin
        loRange.Borders(xlEdgeTop).Weight = xlThin
    loRange.Borders(xlEdgeBottom).Weight = xlThin
    loRange.Borders(xlEdgeRight).Weight = xlThin
    loRange.Borders(xlInsideVertical).Weight = xlThin
    loRange.Borders(xlInsideHorizontal).Weight = xlThin
                    
    WITH XLSheet.PageSetup
       .Orientation =    xlLandscape
         .LeftMargin =  XLApp.InchesToPoints(0.1)
       .RightMargin = XLApp.InchesToPoints(0.1)
           .TopMargin =  XLApp.InchesToPoints(0.15)
           .BottomMargin = XLApp.InchesToPoints(0.15)
           .HeaderMargin =     XLApp.InchesToPoints(0.1)
           .FooterMargin =     XLApp.InchesToPoints(0.1)
       .PrintHeadings =     .F.
       .PrintGridlines =     .F.
    ENDWITH 

    XLApp.VISIBLE    = .t.

' Отключить обновление
Public Sub Prepare()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    ActiveSheet.DisplayPageBreaks = False
    Application.DisplayStatusBar = False
    Application.DisplayAlerts = False
End Sub

' Включить обновление
Public Sub Ended()
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    ActiveSheet.DisplayPageBreaks = True
    Application.DisplayStatusBar = True
    Application.DisplayAlerts = True
End Sub

lcFile='полный_путь_к_файлу_типа C:\temp\книга1.xls'

SELECT 0
CREATE CURSOR c1 (cname c(20), lnum i, ldate d)
INSERT INTO c1 (cname, lnum, ldate) VALUES ('Вася', 4, {^1978-12-24})
INSERT INTO c1 (cname, lnum, ldate) VALUES ('Петя', 3, {^1987-05-12})
INSERT INTO c1 (cname, lnum, ldate) VALUES ('Маша', 100500, {^1984-01-08})
INSERT INTO c1 (cname, lnum, ldate) VALUES ('Гриша', 135, {^1973-08-30})

SELECT * FROM c1 INTO ARRAY laData 
lcRowsData=ALEN(laData,1)
lcColumnsData=ALEN(laData,2)            

#DEFINE xlOpenXMLWorkbook   51
#DEFINE xlNormal   -4143

loExcel=CREATEOBJECT("EXCEL.APPLICATION")
lxlsversion=VAL(loExcel.Version)
loExcel.Visible=.F.
loExcel.EnableEvents=.F.    
loExcel.DisplayAlerts=.F.

IF TYPE('loExcel')='O'
    loExcel.Workbooks.Add()
    lcWbName=loExcel.ActiveWorkbook.Name
    IF lxlsversion>=12
        loExcel.ActiveWorkbook.SaveAs(lcFile,xlOpenXMLWorkbook)
    ELSE 
        loExcel.Workbooks(lcWbName).SaveAs(lcFile,xlNormal)
    ENDIF
    lcWbName=JUSTFNAME(lcFile)    
    
    loSheet = loExcel.Workbooks(lcWbName).Sheets(1)
    loSheet.Cells(2,1).Resize(lcRowsData, lcColumnsData).Value = PassArray('laData')                        
    loExcel.Workbooks(lcWbName).Save()
    loExcel.Workbooks(lcWbName).Close(.F.)
    
    loExcel.Quit()
ENDIF 


FUNCTION PassArray
LPARAMETERS tcArrayName
* Трюк для передачи массива данных обратно в диапазон ячеек Excel.  
RETURN @&tcArrayName

loExcel.Workbooks.Add(lcFileMask)