Private Sub Кнопка3_Click()
Dim nRows As Long
Dim myOlApp As Excel.Application
Dim MyWo As Excel.Workbook
Dim mysheet As Excel.Worksheet
Dim MyCel As Variant
Dim MyRst As ADODB.Recordset
Dim ct As Long
DoCmd.OutputTo acOutputTable, "svod", acFormatXLS, "c:\test.xls", False
Set myOlApp = New Excel.Application
Set MyWo = myOlApp.Workbooks.Open("c:\test.xls")
Set mysheet = MyWo.Worksheets("svod")
 '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 

 '+++++++++++++ Изменение шрифта названий задач++++++++++++++++++++++++++++++++++++++++++++++
 
mysheet.Rows("1:1").Select
With myOlApp.Selection
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation =  0 
        .AddIndent = False
        .IndentLevel =  0 
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    myOlApp.Selection.Rows.AutoFit
 '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
Set MyRst = New ADODB.Recordset
MyRst.Open "select * from balance", CurrentProject.Connection, adOpenStatic, adLockReadOnly
ct =  2 
 '++++++++++++Подсчёт суммарной стоимости по строкам и столбцам+++++++++++++++++++++++++++++++++++
 
nRows = mysheet.Range("A1").CurrentRegion.Rows.Count
 'ncolum = mysheet.Columns.Count
 
mysheet.Range("a" & (nRows +  1 )).Value = "Итого"
Set MyRst2 = New ADODB.Recordset
MyRst2.Open "select * from svod", CurrentProject.Connection, adOpenStatic, adLockReadOnly
mysheet.Range(Chr(MyRst.Fields.Count +  99 ) & "1").Value = "Итого"
For i =  98  To MyRst.Fields.Count +  98 
mysheet.Range(Chr(i) & nRows +  1 ).Formula = "=SUM($" & Chr(i) & "$2:$" & Chr(i) & "$" & nRows & ")"
Next i
For i =  98  To MyRst.RecordCount +  98 
mysheet.Range(Chr( 97  + MyRst2.Fields.Count) & (i -  96 )).Formula = "=SUM($" & Chr( 98 ) & "$" & (i -  96 ) & ":$" & Chr(MyRst2.Fields.Count -  2  +  98 ) & "$" & (i -  96 ) & ")"
Next i
 '+++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
Do Until MyRst.EOF
   If MyRst![type_balance] =  1  Then
    mysheet.Cells(ct,  1 ).Select
    myOlApp.Selection.Font.Bold = True
    myOlApp.Selection.Font.Italic = True
   End If
ct = ct +  1 
MyRst.MoveNext
Loop
MyRst.Close
Set MyRst = Nothing
 '++++++++++++++++++++++++
 
MyWo.Save
Set mysheet = Nothing
MyWo.Close
Set MyWo = Nothing
 'Application.Quit
 
myOlApp.Quit
Set myOlApp = Nothing
End Sub