grafy

Attribute VB_Name = "grafy"
Sub graf()
    '
    'Function for creating graphs.
    '
'    On Error GoTo ErrorCounter
    On Error Resume Next    'if error occures, usualy helps to run function second time
    
    Dim Pic As Object
    
    Range(GRAPH_RANGE).Select   'double check of deleting space where graphs will be
    Range(GRAPH_RANGE).Delete
    Range(GRAPH_RANGE).Clear

    For Each Pic In ActiveSheet.Pictures
        If Not Intersect(Pic.TopLeftCell, Range(GRAPH_RANGE_PLUS_ONE)) Is Nothing Then
            Pic.Delete
        End If
    Next Pic
    'find every picture in given range and delete it. Excel is not deleting pictures
    'with Delete or Clear functions
    
    '
    ' /// Graph of height ///
    '
    
    Range("AL16:AR25").Select
    ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select 'create graph of type 2
    ActiveChart.SetSourceData Source:=Range("AI17:AJ25")    'source data
    With ActiveChart.Parent
        .Top = Range("AL16").Top 'set position of graph - upper border on this cell
        .Left = Range("AL16").Left 'left border at this cell
        .Width = Range("AL16:AR25").Width
        .Height = Range("AL16:AR25").Height
    End With
    ActiveChart.HasLegend = False
    With ActiveChart.Axes(xlCategory) 'add label to the lower axis
        .HasTitle = True
        .AxisTitle.Text = "Výška knihy v cm"
    End With
    With ActiveChart.Axes(xlValue) 'add label of left axis
        .HasTitle = True
        .AxisTitle.Text = "Poèet kníh"
    End With
    ActiveChart.Parent.Name = "Graf1"   'add graph a name so I can manipulate it
    ActiveChart.HasTitle = True
    ActiveChart.ChartTitle.Text = "Výška kníh"
    ActiveChart.FullSeriesCollection(1).ApplyDataLabels 'activate graph's labels
    ActiveChart.ChartGroups(1).GapWidth = 52
    Application.CommandBars("Format Object").Visible = False
    ActiveChart.PlotArea.Select
    Application.CommandBars("Format Object").Visible = False
    ActiveChart.ChartArea.Select
    ActiveChart.FullSeriesCollection(1).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(79, 129, 93)
        .Transparency = 0
        .Solid
    End With
    
    ActiveSheet.ChartObjects("Graf1").Activate  'activate the specific graph
    ActiveChart.Parent.Cut                      'cut it to clipboard
    Range("AT16").Select                      'and paste it to different cell
    ActiveSheet.Paste
    'there was a problem with exporting graph as a picture, when it was only in clipboard
    
    ActiveSheet.ChartObjects("Graf1").Chart.CopyPicture xlScreen, xlBitmap  'select graph, copy it as a picture
    ActiveSheet.ChartObjects("Graf1").Delete    'delete graph
    Range("AL16").Select
    ActiveSheet.Pictures.Paste.Select   'paste pic of graph
    
    
    '
    ' /// Graph of width ///
    '
    ' same Algortihm as above, but for different graph.
    'Maybe it could be written more general way and applied for both graphs at once,
    'but I doubt it would improve performance
    
    Range("AL27:AR36").Select
    ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
    ActiveChart.SetSourceData Source:=Range("AI28:AJ36")
    With ActiveChart.Parent
        .Top = Range("AL27").Top
        .Left = Range("AL27").Left
        .Width = Range("AL27:AR36").Width
        .Height = Range("AL27:AR36").Height
    End With
    ActiveChart.HasLegend = False
    With ActiveChart.Axes(xlCategory)
        .HasTitle = True
        .AxisTitle.Text = "Šírka knihy v cm"
    End With
    With ActiveChart.Axes(xlValue)
        .HasTitle = True
        .AxisTitle.Text = "Poèet kníh"
    End With
    ActiveChart.Parent.Name = "Graf2"
    ActiveChart.HasTitle = True
    ActiveChart.ChartTitle.Text = "Šírka kníh"
    ActiveChart.FullSeriesCollection(1).ApplyDataLabels
    ActiveChart.ChartGroups(1).GapWidth = 52
    ActiveChart.ChartColor = RGB(79, 129, 93)
    Application.CommandBars("Format Object").Visible = False
    ActiveChart.PlotArea.Select
    Application.CommandBars("Format Object").Visible = False
    ActiveChart.ChartArea.Select
    ActiveChart.FullSeriesCollection(1).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(79, 129, 93)
        .Transparency = 0
        .Solid
    End With
    
    ActiveSheet.ChartObjects("Graf2").Activate
    ActiveChart.Parent.Cut
    Range("AT27").Select
    ActiveSheet.Paste
    
    ActiveSheet.ChartObjects("Graf2").Chart.CopyPicture xlScreen, xlBitmap
    ActiveSheet.ChartObjects("Graf2").Delete
    Range("AL27").Select
    ActiveSheet.Pictures.Paste.Select
End Sub