chartobject.add

[mikelmco]

The following code works; however, the chart is now placed in a different spot on the worksheet, and it's not as large as it was the last time I ran the program. I'd like to use ChartObjects.Add so that I can adjust the position and size of the chart, but I'm having trouble with the assignments. How would the code change?


Sub Draw_Core_NonCore_Chart()
Dim Series_Range As Range

Charts.Add
ActiveChart.ChartType = xl3DColumnClustered
ActiveChart.SetSourceData Source:=Sheets("Sheet1").Range("R18")

Dim i As Integer
i = 1
Do Until Sheets("Sheet1").Cells(3, i + 1).Interior.ColorIndex = 48
ActiveChart.SeriesCollection.NewSeries

Set Series_Range = Sheets("Sheet1").Range(Sheets("Sheet1").Cells(4, i + 1), Sheets("Sheet1").Cells(7, i + 1))
ActiveChart.SeriesCollection(i).Values = Series_Range
ActiveChart.SeriesCollection(i).Name = Sheets("Sheet1").Cells(3, i + 1)
ActiveChart.SeriesCollection(i).XValues = "='Sheet1'!R4C1:R7C1"

Set SeriesFac = Sheets("Sheet1").Cells(3, i + 1)
With ActiveChart.SeriesCollection(i)
Select Case SeriesFac.Text
Case Is = "Air Force"
.Interior.ColorIndex = 15
Case Is = "Army"
.Interior.ColorIndex = 15
Case Is = "Navy"
.Interior.ColorIndex = 15
Case Is = "DoD"
.Interior.ColorIndex = 37
Case Is = "National"
.Interior.ColorIndex = 55
End Select
End With

i = i + 1
Loop


ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1"
With ActiveChart
.HasTitle = False
.Axes(xlCategory).HasTitle = False
.Axes(xlSeries).HasTitle = False
.Axes(xlValue).HasTitle = True
.Axes(xlValue).AxisTitle.Characters.Text = "Rate"
End With

With ActiveChart.Axes(xlCategory)
.HasMajorGridlines = False
.HasMinorGridlines = False
End With

With ActiveChart.Axes(xlSeries)
.HasMajorGridlines = False
.HasMinorGridlines = False
End With

With ActiveChart.Axes(xlValue)
.HasMajorGridlines = False
.HasMinorGridlines = False
End With

ActiveChart.WallsAndGridlines2D = False
ActiveChart.HasLegend = True
ActiveChart.Legend.Select
Selection.Position = xlBottom
ActiveChart.HasDataTable = False
ActiveChart.Walls.Select

With Selection.Border
.ColorIndex = 16
.Weight = xlThin
.LineStyle = xlNone
End With

With Selection.Interior
.ColorIndex = 2
.PatternColorIndex = 1
.Pattern = xlSolid
End With

ActiveChart.Axes(xlValue).AxisTitle.Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Orientation = xlUpward
End With

ActiveChart.Walls.Select
With ActiveChart
.Elevation = 15
.Perspective = 30
.Rotation = 20
.RightAngleAxes = True
.HeightPercent = 100
.AutoScaling = True
End With

With ActiveChart.Axes(xlValue)
.MinimumScale = 0
.MaximumScale = 1
.MinorUnit = 0.02
.MajorUnit = 0.1
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
End Sub

 

[Datsmart]

Don't know about your code, but the code below will Size a chart to the cordinants of the listed cell range.

Sub SizeChart()
Dim MyRange As Range
Set MyRange = Sheets("Sheet7").Range("C3:I16")
' Position Chart to cell cordinants
    With ActiveSheet
        For I = 1 To .ChartObjects.Count
            .ChartObjects(I).Left = MyRange.Left
            .ChartObjects(I).Top = MyRange.Top
            .ChartObjects(I).Width = MyRange.Width
            .ChartObjects(I).Height = MyRange.Height
        Next I
    End With
End Sub