Excel Access |
Sub StajInExcel ( As Double) On Error GoTo Err_StajInExcel Dim xlApp As Excel.Application Dim xlBook As Excel.Workbook Dim xlSheet As Excel.Worksheet Dim objPivotCache As Excel.PivotCache Dim MyRange As Excel.Range Dim rs As New ADODB.Recordset rs.CursorLocation = adUseClient ' rs.Open "SELECT First(.) AS , First(.) AS , Sum(.X1) AS X, .1 AS [] " & _ "FROM GROUP BY .1, ., ., ., .1 HAVING (((First(.))=" & & ") AND " & _ "((Count(.))>1) AND ((Count(.))>1));", _ CurrentProject.Connection, adOpenStatic, adLockReadOnly, adCmdText Set xlApp = CreateObject("Excel.Application") ' MSExcel Set xlBook = xlApp.Workbooks.Add ' Excel 'xlApp.Visible = True ' ( ) xlApp.DisplayAlerts = False ' MSExcel Set xlSheet = xlBook.Sheets(1) With xlSheet .Name = "" ' ' (xlExternal) Set objPivotCache = xlBook.PivotCaches.Add(xlExternal) ' (rs) Set objPivotCache.Recordset = rs rs.Close ' , .. Set rs = Nothing ' ' , .PivotTables.Add PivotCache:=objPivotCache, TableDestination:=.Cells(2, 1), TableName:="Svodnaya" With .PivotTables("Svodnaya").PivotFields("") .Orientation = xlRowField ' .Position = 1 ' 1 End With With .PivotTables("Svodnaya").PivotFields("") .Orientation = xlRowField ' .Position = 2 ' 2 End With With .PivotTables("Svodnaya").PivotFields("") .Orientation = xlColumnField ' .Position = 1 ' 1 End With ' .PivotTables("Svodnaya").AddDataField .PivotTables _ ("Svodnaya").PivotFields("X"), "X" ', xlSum '================================================================================= ' ! '================================================================================= '================================================================================= ' '================================================================================= ' ( - xlColumnClustered) xlApp.Charts.Add xlApp.ActiveChart.ChartType = xlColumnClustered xlApp.ActiveChart.PlotArea.Interior.ColorIndex = xlNone ' () xlApp.ActiveChart.HasTitle = True ' xlApp.ActiveChart.ChartTitle.Characters.Text = "" xlApp.ActiveChart.Legend.Position = xlTop ' xlApp.ActiveSheet.Name = "" ' .Visible = xlSheetVeryHidden End With ' '' xlApp.ActiveWorkbook.ShowPivotTableFieldList = False xlApp.CommandBars("PivotTable").Visible = False xlApp.CommandBars("Chart").Visible = False ' Staj.xls xlBook.SaveAs FileName:=CurrentProject.Path & "\Staj", _ FileFormat:=xlNormal, Password:="", WriteResPassword:="", _ ReadOnlyRecommended:=False, CreateBackup:=False xlApp.DisplayAlerts = True ' MSExcel xlApp.Visible = True ' xlApp.CalculateFull Set xlSheet = Nothing Set xlBook = Nothing Set xlApp = Nothing Exit Sub Err_StajInExcel: MsgBox Err.Description, vbCritical + vbMsgBoxHelpButton, _ " " & Err.number, Err.HelpFile, Err.HelpContext On Error Resume Next xlApp.Quit End Sub
http://www.sql.ru/forum/1091181/sozdanie-diagrammy-excel-iz-access