Получение данных и постройка графика с Excel таблицы. - VB
Формулировка задачи:
U menia est` baza dannih v Excel, i mne nuzno polucit` iz nee dannie i postroit` grafic
Spasibo za luboi sovet
Решение задачи: «Получение данных и постройка графика с Excel таблицы.»
textual
Листинг программы
Dim i, j, tmpRange
If ActiveGrafic <> '' Then
Set AppExcel = CreateObject('Excel.Application')
Set wbO = AppExcel.Workbooks.Add
Set wsH = AppExcel.Sheets(1)
wsH.Name = 'Data'
AppExcel.DisplayAlerts = False
AppExcel.AlertBeforeOverwriting = False
tmpRange = F1Range(ArrForms(ActiveGrafic).F1Book1.MaxCol, 1, ArrForms(ActiveGrafic).F1Book1.MaxRow)
For i = 1 To ArrForms(ActiveGrafic).F1Book1.MaxCol
For j = 1 To ArrForms(ActiveGrafic).F1Book1.MaxRow
wsH.Cells(j, i).Value = ValGet(j, i)
Next j
Next i
Set wsH2 = AppExcel.Sheets(2)
wsH2.Name = 'Grafics'
Set Charts = wsH2.ChartObjects
Set Chart = Charts.Add(0, 0, ArrForms(ActiveGrafic).OLEGrafik.Width / 19, ArrForms(ActiveGrafic).OLEGrafik.Height / 19)
With Chart.Chart
.SetSourceData Source:=wsH.Range(tmpRange)
.HasDataTable = ArrFormSetting(ActiveGrafic, 2)
.HasLegend = ArrFormSetting(ActiveGrafic, 1)
End With
For i = 1 To Chart.Chart.SeriesCollection.Count
Chart.Chart.SeriesCollection(i).HasDataLabels = ArrFormSetting(ActiveGrafic, 3)
If ArrFormSetting(ActiveGrafic, 3) = 1 Then
Chart.Chart.SeriesCollection(i).DataLabels.NumberFormat = '0.0'
End If
Next i
For i = 1 To Chart.Chart.SeriesCollection.Count
Chart.Chart.SeriesCollection(i).Interior.Color = ArrForms(ActiveGrafic).OLEGrafik.ChartGroups(1).Styles(i).Fill.Interior.ForegroundColor 'ArrForms(ActiveGrafic).lblLegend(i).ForeColor
Next i
For i = 1 To Chart.Chart.SeriesCollection.Count
'wsH.Cells(i + 1, 1).Value = ArrFormData(ActiveGrafic, i)
Next i
wsH2.Activate
If Deistvie = 1 Then
wsH2.Activate
AppExcel.ActiveWorkbook.Application.Visible = True
AppExcel.ActiveSheet.PrintPreview
End If
AppExcel.ActiveWorkbook.SaveAs FileName:='c:grafik.xls'
If Deistvie = 2 Then
If MsgBox('Г”Г*éë C:grafik.xls ÑîçäГ*Г*!' & vbCrLf & 'Îòêðûòü äëÿ ïðîñìîòðГ*?', vbOKCancel) = vbOK Then
AppExcel.ActiveWorkbook.Application.Visible = True
AppExcel.DisplayAlerts = True
AppExcel.AlertBeforeOverwriting = True
Set AppExcel = Nothing
Set wbO = Nothing
Set wsH = Nothing
Set wsH2 = Nothing
Set Chart = Nothing
Set Charts = Nothing
Else
ExcelClose
End If
End If
End If
End Sub