Подскажите пожалуйста что не так?
в этом варианте все нормально
Private Sub Кнопка0_Click()
Dim xlApp As Object
Dim wkb As Workbook
Set xlApp = CreateObject("excel.application")
Set wkb = xlApp.Workbooks.Add
xlApp.Visible = True
wkb.SaveAs Filename:="D:\MyDB\Zakaz.xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
xlApp.Quit
Set xlApp = Nothing
End Sub
а в этом варианте не хочет закрываться
Private Sub btn_Otchet_Click()
On Error GoTo Err_btn_Otchet_Click
Dim xlApp As Object
Dim wkb As Workbook
Set xlApp = CreateObject("excel.application")
Set wkb = xlApp.Workbooks.Add
xlApp.Visible = True
Manager = "((tbl_Zakaz.Manager_Zakaz)='" & Form_frm_Otchet.cb_Manager & "') AND "
Manager = ""
Set MyDb = CurrentDb
MySQL = "SELECT q_Otchet.Grup_Grup, q_Otchet.Goods_Goods, q_Otchet.Ed_Goods, Sum(q_Otchet.Kolvo_Zakaz) AS Kolvo_Zakaz, Sum(q_Otchet.Ves) AS Ves" & _
" FROM (SELECT tbl_Grup.ID_Grup, tbl_Grup.Grup_Grup, tbl_Goods.Goods_Goods, tbl_Goods.Ed_Goods, tbl_Zakaz.Kolvo_Zakaz, [Kolvo_Zakaz]*[Kr_Goods]/1000 AS Ves, tbl_Zavod.ID_Zavod" & _
" FROM tbl_Zavod INNER JOIN (tbl_Grup INNER JOIN (tbl_Data INNER JOIN (tbl_Goods INNER JOIN tbl_Zakaz ON tbl_Goods.ID_Goods = tbl_Zakaz.Goods_Zakaz) ON tbl_Data.ID_Data = tbl_Zakaz.Data_Zakaz) ON tbl_Grup.ID_Grup = tbl_Goods.Grup_Goods) ON tbl_Zavod.ID_Zavod = tbl_Goods.Zavod_Goods" & _
" WHERE (" & Manager & "((tbl_Data.Data_Data)=" & CLng(Form_frm_Zakaz.DataZakaz) & ") AND ((tbl_Zavod.ID_Zavod)=" & Form_frm_Zakaz.V_Zavod & "))) AS q_Otchet" & _
" GROUP BY q_Otchet.Grup_Grup, q_Otchet.Goods_Goods, q_Otchet.Ed_Goods, q_Otchet.ID_Grup, q_Otchet.Goods_Goods" & _
" ORDER BY q_Otchet.ID_Grup, q_Otchet.Goods_Goods"
Set TestTable = MyDb.OpenRecordset(MySQL)
TestTable.MoveLast
If (TestTable.RecordCount > 0) Then
TestTable.MoveFirst
' Вставка рекордсета
MyRow = 2
MyCol = 1
Cells(MyRow, MyCol).CopyFromRecordset TestTable
' Вставка шапки(заголовков) рекордсета
intFildCount = TestTable.Fields.Count - 1
For intI = 0 To intFildCount
Cells(MyRow - 1, intI + MyCol).Value = TestTable.Fields(intI).Name
Next intI
Else: MsgBox "Not Found"
End If
TestTable.Close
MyDb.Close
Set MyDb = Nothing
GrupAr = Array("Ветчина", "в/к колбасы", "Вареные колбасы", "п/к колбасы", _
"с/к колбасы", "Колбаски", "Котлеты", "Пельмени", _
"м/к", "Паштет", "Ребра", "Сардельки", "Сервелат", "Сосиски", _
"Прочее", "Хлеб", "Полуфабрикаты", "Изделия в желе", "Фарш")
'----------------------------------------------------------------------------------------
Sheets("Лист1").Select
Cells.Copy
Sheets("Лист2").Select
Cells.Select
ActiveSheet.Paste
'--------------------------------------------------------------------
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
With Selection.Font
.Name = "Arial"
.Size = 10
.Bold = False
.ColorIndex = 0
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With
''---------------------------------------------------------------------------------
Range("A2").Select
Selection.End(xlDown).Select
EndRow = Selection.Cells.Row
b = 0
For i = 2 To EndRow
For j = 0 To 18
If Cells(i, 1) = GrupAr(j) And Cells(i, 1) <> Cells(i - 1, 1) Then
Range(Cells(i + 2, 1), Cells(i + 2, 1)).Select
b = b + 1
End If
Next j
Next i
For i = 2 To EndRow + b
For j = 0 To 18
If Cells(i, 1) = GrupAr(j) And Cells(i, 1) <> Cells(i - 1, 1) Then
Gr = GrupAr(j)
Cells(i, 1).EntireRow.Insert
Cells(i, 2) = Gr
Range(Cells(i, 2), Cells(i, 5)).Select
Selection.Merge
With Selection.Interior
.ColorIndex = 48
.Pattern = xlSolid
End With
With Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 55
.Bold = True
End With
Range(Cells(i + 2, 1), Cells(i + 2, 1)).Select
i = 1 + i
End If
Next j
Next i
Range("A1").EntireColumn.Delete
Range("A1") = "Товар"
Range("B1") = "Ед."
Range("C1") = "Кол-во"
Range("D1") = "Кг"
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Font.Bold = True
Selection.HorizontalAlignment = xlCenter
Range(Selection, Selection.End(xlDown)).Select
''---------------------------------------------------------------------------------
Selection.Columns.AutoFit
Gran = Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight, _
xlInsideVertical, xlInsideHorizontal)
For i = 0 To 5 Step 1
With Selection.Borders(Gran(i))
.LineStyle = 1
If i > 3 Then
.Weight = xlThin
Else:
.Weight = xlMedium
End If
.ColorIndex = xlAutomatic
End With
Next i
'---------------------------------------------------------------------------------
Range("A1").Select
Selection.End(xlDown).Select
EndRow = Selection.Cells.Row
Range(Cells(EndRow + 1, 4), Cells(EndRow + 1, 4)).Select
ActiveCell.FormulaR1C1 = "=SUM(R[-" & EndRow - 2 & "]C:R[-1]C)"
Range("A1").Select
Selection.EntireRow.Insert
Selection.EntireRow.Insert
Selection.EntireRow.Insert
'---------------------------------------------------------------------------------
Range("A1").Select
Set MyDb = CurrentDb
MySQL = "SELECT [Zavod_Zavod] & ' тел:' & [Telephon] AS Zavod FROM tbl_Zavod WHERE (((tbl_Zavod.ID_Zavod)=" & Form_frm_Zakaz.V_Zavod & "))"
Set TestTable = MyDb.OpenRecordset(MySQL)
TestTable.MoveLast
If (TestTable.RecordCount > 0) Then
TestTable.MoveFirst
' Вставка рекордсета
MyRow = 1
MyCol = 1
Cells(MyRow, MyCol).CopyFromRecordset TestTable
Else: MsgBox "Not Found"
End If
TestTable.Close
MyDb.Close
Set MyDb = Nothing
Range("A2") = "Заявка ИП Дружинин на " & Form_frm_Zakaz.DataZakaz
wkb.SaveAs Filename:="D:\MyDB\Zakaz.xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
xlApp.Quit
Set xlApp = Nothing
MsgBox "Отчет готов"
Exit_btn_Otchet_Click:
Exit Sub
Err_btn_Otchet_Click:
MsgBox Err.Description
Resume Exit_btn_Otchet_Click
End Sub