Ñîçäàíèå äèàãðàììû 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
| Êîììåíòèðîâàòü | « Ïðåä. çàïèñü — Ê äíåâíèêó — Ñëåä. çàïèñü » | Ñòðàíèöû: [1] [Íîâûå] |