Получение данных и постройка графика с 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

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

12   голосов , оценка 4.333 из 5