VBA Help Modify Code - Prevent chart from resizing with columns / rows

LNG2013

Active Member
Joined
May 23, 2011
Messages
465
I have the below code that creates a chart on each one of my sheets. I would like each chart to also not change size when the columns resize.

Doing a recording I can see it is usually
VBA Code:
.Placement = xlMove
When I tried that with my code below the code would not run. Any other thoughts?



VBA Code:
Sub CreateAICharts()

'~~~ This code Add the Graph Chart for the code scores
Dim co As ChartObject, endh%, h%, r$, sname$, suffix

'~~~ Suffix allows the code to be manipulated more easily with changing the sheet name but keeping the Suffix the same
suffix = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "10")
For h = LBound(suffix) To UBound(suffix)
    On Error Resume Next
    '~~~ name of sheet is currently set for Data
    sname = "Data" & suffix(h)
    endi = Sheets(sname).Range("h65536").End(xlUp).Row
    '~~~ -7 is put in place to remove the bottom % bar from calculation of data for graph
    r = "h3:h" & endi - 7
    
    '~~~ This area of the code indicates the shape and location of the chart
    Set co = Worksheets(sname).ChartObjects.Add(Left:=Cells(1, 1).Left, Width:=305, _
    Top:=Cells(endi + 3, 1).Top, Height:=200)

    
    On Error Resume Next

    
    '~~~ This section of the code indicates the properties of the chart
    With co.Chart
        .SetSourceData Source:=Sheets(sname).Range(r), PlotBy:=xlColumns
        .ChartType = xlLineMarkers
        .ChartTitle = "Scores"
        .Axes(xlCategory, xlPrimary).HasTitle = False
        .Axes(xlValue, xlPrimary).HasTitle = False

        .PlotArea.Fill.TwoColorGradient Style:=msoGradientVertical, Variant:=1
        .PlotArea.Fill.Visible = True
        .PlotArea.Fill.ForeColor.SchemeColor = 37
        .PlotArea.Fill.BackColor.SchemeColor = 2
        .Legend.Delete
            With .ChartArea.Border
                .ColorIndex = 57
                .ColorIndex = 57
                .Weight = 2
                .LineStyle = 1
            End With
            

    With co.Chart.Axes(xlValue)
        .MinimumScale = 0
        .MaximumScale = 8
        .MinorUnitIsAuto = True
        .MajorUnit = 1
        .Crosses = xlAutomatic
        .ReversePlotOrder = False
        .ScaleType = xlLinear
        .DisplayUnit = xlNone
    End With
    With co.Chart
        .HasTitle = True
        .ChartTitle.Characters.Text = "Data"

        .ChartTitle.Font.Name = "Tahoma"
        .ChartTitle.Font.Size = 10
        .ChartTitle.Font.Bold = True
'This did not work to prevent chart size from changing. It would not run with the code.
        '.Placement = xlMove
    End With
    With co.Chart
    .PlotArea.Height = 170
    
    End With
    
    
        
    End With
  
 

Next
   On Error GoTo 0

End Sub
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
Try adding the "Placement" instruction in the following position:
VBA Code:
    Set co = Worksheets(sname).ChartObjects.Add(Left:=Cells(1, 1).Left, Width:=305, _
    Top:=Cells(endi + 3, 1).Top, Height:=200)

    co.Placement = xlFreeFloating       '<<< ADD THIS LINE
    On Error Resume Next
 
Upvote 0
Solution
Try adding the "Placement" instruction in the following position:
VBA Code:
    Set co = Worksheets(sname).ChartObjects.Add(Left:=Cells(1, 1).Left, Width:=305, _
    Top:=Cells(endi + 3, 1).Top, Height:=200)

    co.Placement = xlFreeFloating       '<<< ADD THIS LINE
    On Error Resume Next
This worked but prevented the Charts from being copied in later code.

VBA Code:
'~~~ Changed it to 
   co.Placement = xlMove
 
Upvote 0
Thank you for the feedback
(And good to know that you learned how "playing" with the "Placement" property)
 
Upvote 0

Forum statistics

Threads
1,214,983
Messages
6,122,583
Members
449,089
Latest member
Motoracer88

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top