Quantcast
Channel: Active questions tagged excel - Stack Overflow
Viewing all articles
Browse latest Browse all 88066

Setting default chart parametersin Excel/VBA

$
0
0

I have a process in MSAccess that culls data then creates a new excel workbook, pushes data out to it then creates a chart in excel.

Once created, the chart is formatted to our preferred look.
That is where things slow down. We are setting up each individual chart after it has been drawn and with 150 or so charts total, it takes a while.

What I am wondering is, can all of the chart parameters we want be set programmatically as default? That way, we set once and all charts drawn are in that format from the beginning.

Code used to generate and format charts attached.

Thanks

Sub CreateChart(ObjXlWs As Worksheet, K As Integer)
Dim ObjXlChrt As Chart
Dim FixChart As ChartObject
Dim Cntr, J As Integer
Dim ChartNm
Dim xRg As Range

Cntr = K
Set xRg = Range(Split(Cells(1, (((Cntr - 1) * 12 + 1) + 1)).Address, "$")(1) & "4:"& (Split(Cells(1, (((Cntr - 1) * 12 + 10) + 1)).Address, "$")(1) & "26"))

    Set ObjXlChrt = ObjXlWs.ChartObjects.Add(50, 40, 600, 400).Chart
    ObjXlChrt.ChartType = xlLineMarkers
    ObjXlChrt.SetSourceData Source:=Sheets(ObjXlWs.Name).Range(Split(Cells(1, (((Cntr - 1) * 12 + 2) + 1)).Address, "$")(1) & "66:"& _
        Split(Cells(1, (((Cntr - 1) * 12 + 7) + 1)).Address, "$")(1) & 65 + ObjXlWs.Range(Split(Cells(1, (((Cntr - 1) * 12 + 5) + 1)).Address, "$")(1) & "62").Value), PlotBy:=xlColumns
    ObjXlChrt.Location Where:=xlLocationAsObject, Name:=ObjXlWs.Name
    Set FixChart = ActiveSheet.ChartObjects(K)
    With FixChart
        .Top = xRg(1).Top
        .Left = xRg(1).Left
        .Width = xRg.Width
        .Height = xRg.Height
    End With

    With ObjXlChrt
        .HasAxis(xlCategory, xlPrimary) = True
        .HasAxis(xlValue, xlPrimary) = True
        .HasTitle = False
        .Axes(xlCategory).CategoryType = xlCategoryScale
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Date:"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = Sheets(ObjXlWs.Name).Range(Split(Cells(1, (((Cntr - 1) * 12 + 1) + 1)).Address, "$")(1) & "60").Value
        .Axes(xlCategory).HasMajorGridlines = False
        .Axes(xlCategory).HasMinorGridlines = False
        .Axes(xlValue).HasMajorGridlines = False
        .Axes(xlValue).HasMinorGridlines = False
        .HasLegend = False
    End With

   With ObjXlChrt.Axes(xlCategory).TickLabels
        .Orientation = xlUpward
        .Font.Name = "Arial"
        .Font.FontStyle = "Regular"
        .Font.Size = 8
    End With

    With ObjXlChrt.Axes(xlCategory).AxisTitle
        .Font.Name = "Arial"
        .Font.FontStyle = "Regular"
        .Font.Size = 8
    End With

    With ObjXlChrt.Axes(xlValue).TickLabels
        .Font.Name = "Arial"
        .Font.FontStyle = "Regular"
        .Font.Size = 8
    End With

    With ObjXlChrt.Axes(xlValue).AxisTitle
        .Font.Name = "Arial"
        .Font.FontStyle = "Regular"
        .Font.Size = 8
    End With

    ObjXlChrt.PlotArea.ClearFormats

    ObjXlChrt.Axes(xlCategory).AxisTitle.Left = 16
    ObjXlChrt.Axes(xlCategory).AxisTitle.Top = 300

    ObjXlChrt.PlotArea.Left = 45
    ObjXlChrt.PlotArea.Width = 425
    ObjXlChrt.PlotArea.Top = 21
    ObjXlChrt.PlotArea.Height = 310

    On Error Resume Next

    With ObjXlChrt.SeriesCollection(5)
        .Border.ColorIndex = 1
        .Border.Weight = xlThin
        .Border.LineStyle = xlDot
        .MarkerStyle = xlNone
    End With

    With ObjXlChrt.SeriesCollection(4)
        .Border.ColorIndex = 1
        .Border.Weight = xlThin
        .Border.LineStyle = xlDot
        .MarkerStyle = xlNone
    End With

    With ObjXlChrt.SeriesCollection(3)
        .Border.ColorIndex = 1
        .Border.Weight = xlThin
        .Border.LineStyle = xlDashDot
        .MarkerStyle = xlNone
    End With

    With ObjXlChrt.SeriesCollection(2)
        .Border.ColorIndex = 1
        .Border.Weight = xlThin
        .Border.LineStyle = xlContinuous
        .MarkerStyle = xlSquare
        .MarkerBackgroundColorIndex = 2
        .MarkerForegroundColorIndex = 1
        .MarkerSize = 3
    End With

    With ObjXlChrt.SeriesCollection(1)
        .Border.ColorIndex = 1
        .Border.Weight = xlHairline
        .Border.LineStyle = xlContinuous
        .MarkerStyle = xlAutomatic
        .MarkerBackgroundColorIndex = xlAutomatic
        .MarkerForegroundColorIndex = xlAutomatic
        .MarkerSize = 3
    End With

    On Error GoTo 0

End Sub

Viewing all articles
Browse latest Browse all 88066

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>