Dim n As Integer
For Each varItm In Me!Отчеты.ItemsSelected
If Me!Отчеты.Selected(varItm) = True Then
n = n + 1
End If
Next varItm
If n = 0 Then
MsgBox "Отчет не выбран!"
Else
For Each varItm In Me!Отчеты.ItemsSelected
Select Case Me!Отчеты.ItemData(varItm)
Case 1
Dim RecSet As DAO.Recordset
Dim xlApp As Object
Dim xlBook As Object
Dim SQL, nm As String
Dim k As Integer
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add("D:\VCNG\Profiles\IvanovaMA\import\otch1pk.xlt")
SQL = "SELECT id, otchet.name, otchet.PostOb, otchet.PostM, otchet.pkOb, otchet.pkM,
otchet.PostavlenoO, otchet.PostavlenoM, otchet.RabotaO, otchet.RabotaM, otchet.SovrSrocO,
otchet.SorvSrocM, otchet.UgrSrO, otchet.UgrSrM FROM otchet WHERE kod_ot=1 and otchet.dat =
#" & Replace(дат.Value, ".", "/") & "#"
Set RecSet = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)
xlBook.Worksheets(1).Range("A7").CopyFromRecordset RecSet
xlApp.Visible = True
xlBook.Application.Worksheets(1).Columns("A:N").Select
With Selection
.WrapText = True
End With
xlBook.Application.Worksheets(1).Columns("C:N").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
nm = "отчет.xls"
xlBook.Application.ActiveWorkbook.SaveAs FileName:=nm, FileFormat:=xlNormal _
, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
n = 0
End Select
Next varItm ' этой строки нет
End If
RecSet.Close: Set RecSet = Nothing
xlBook.Close
xlApp.Application.Quit
Set xlBook = Nothing
Set xlApp = Nothing
Exit Sub
|