Trying to Position the Graph in a spreadsheet

[Eric Penfold]

The code paste the graph but won`t position the Graph in the range specified. Any help much appreciated thanks!

Option Explicit

Sub DailyMail_Chart_Update()

    Dim wb     As Workbook
    Dim ws     As Worksheet
    Dim dwb    As Workbook
    Dim dws    As Worksheet
    Dim LRow   As Long
    Dim cht1   As ChartObject, cht2 As ChartObject
    Dim Month  As Date
    Dim shape  As Excel.shape
    Dim MyWidth As Single, MyHeight As Single
    Dim chtRng As Range

    Set wb = Workbooks("MyPersonal.xlsb")
    Set ws = wb.Worksheets("DailyMail")
    Set dwb = Workbooks("DailyMail.xlsx")
    Set dws = dwb.Worksheets("Daily Mail Update")
    
    With dws
        Set cht1 = .ChartObjects("Daily_Mail_Graph")
        cht1.Activate
        ActiveChart.ChartTitle.Select
        Selection.Characters.Text = Format(Date, "mmmm")
        With Selection.Characters(Start:=1, Length:=30).Font
            .Name = "Arial"
            .FontStyle = "Bold"
            .Size = 16
            ActiveChart.ChartTitle.Left = 600
            ActiveChart.ChartTitle.Top = 0
            dws.ChartObjects("Daily_Mail_Graph").Chart.ChartArea.Copy
            ws.Activate
            With ws
                On Error Resume Next
                .ChartObjects.Delete
                .Paste
                Set cht2 = .ChartObjects("Daily_Mail_Graph")
                cht2.Select
                With Selection
                    .Top = .Range("B40")
                    .Left = .Range("B40")
                    .Width = .Range("B40:Q40")
                    .Height = .Range("B40:Q69")
                End With
            End With
        End With
    End With
    
End Sub

 

[Legacy 143009]

How about to modify this part:

                With Selection
                    .Top = .Range("B1:B40").Height
                    .Left = .Range("A40:B40").Width
                    .Width = .Range("B40:Q40").Width
                    .Height = .Range("B40:Q69").Height
                End With

 

[Eric Penfold]

Sorry still no working

 

[Legacy 143009]

Ok, I've tested it. This works for me:

                 With ws
                   Set cht2 = .ChartObjects("Daily_Mail_Graph")
                    cht2.Top = .Range("B1:B40").Height
                    cht2.Left = .Range("A40:B40").Width
                    cht2.Width = .Range("B40:Q40").Width
                    cht2.Height = .Range("B40:Q69").Height
                End With

I think the problem is because there two nested With satements which is not recommended.

 

[Legacy 143009]

Theni full code will be:

Option Explicit

Sub DailyMail_Chart_Update()

    Dim wb     As Workbook
    Dim ws     As Worksheet
    Dim dwb    As Workbook
    Dim dws    As Worksheet
    Dim LRow   As Long
    Dim cht1   As ChartObject, cht2 As ChartObject
    Dim Month  As Date
    Dim shape  As Excel.shape
    Dim MyWidth As Single, MyHeight As Single
    Dim chtRng As Range

    Set wb = Workbooks("MyPersonal.xlsb")
    Set ws = wb.Worksheets("DailyMail")
    Set dwb = Workbooks("DailyMail.xlsx")
    Set dws = dwb.Worksheets("Daily Mail Update")
 
    With dws
        Set cht1 = .ChartObjects("Daily_Mail_Graph")
        cht1.Activate
        ActiveChart.ChartTitle.Select
        Selection.Characters.Text = Format(Date, "mmmm")
        With Selection.Characters(Start:=1, Length:=30).Font
            .Name = "Arial"
            .FontStyle = "Bold"
            .Size = 16
            ActiveChart.ChartTitle.Left = 600
            ActiveChart.ChartTitle.Top = 0
            dws.ChartObjects("Daily_Mail_Graph").Chart.ChartArea.Copy
            ws.Activate
            With ws
                On Error Resume Next
                .ChartObjects.Delete
                .Paste
             
                 Set cht2 = .ChartObjects("Daily_Mail_Graph")
                 cht2.Top = .Range("B1:B40").Height
                 cht2.Left = .Range("A40:B40").Width
                 cht2.Width = .Range("B40:Q40").Width
                 cht2.Height = .Range("B40:Q69").Height
            End With
        End With
    End With
 
End Sub

 

[Legacy 143009]

Theni full code will be:

Option Explicit

Sub DailyMail_Chart_Update()

    Dim wb     As Workbook
    Dim ws     As Worksheet
    Dim dwb    As Workbook
    Dim dws    As Worksheet
    Dim LRow   As Long
    Dim cht1   As ChartObject, cht2 As ChartObject
    Dim Month  As Date
    Dim shape  As Excel.shape
    Dim MyWidth As Single, MyHeight As Single
    Dim chtRng As Range

    Set wb = Workbooks("MyPersonal.xlsb")
    Set ws = wb.Worksheets("DailyMail")
    Set dwb = Workbooks("DailyMail.xlsx")
    Set dws = dwb.Worksheets("Daily Mail Update")
 
    With dws
        Set cht1 = .ChartObjects("Daily_Mail_Graph")
        cht1.Activate
        ActiveChart.ChartTitle.Select
        Selection.Characters.Text = Format(Date, "mmmm")
        With Selection.Characters(Start:=1, Length:=30).Font
            .Name = "Arial"
            .FontStyle = "Bold"
            .Size = 16
            ActiveChart.ChartTitle.Left = 600
            ActiveChart.ChartTitle.Top = 0
            dws.ChartObjects("Daily_Mail_Graph").Chart.ChartArea.Copy
            ws.Activate
            With ws
                On Error Resume Next
                .ChartObjects.Delete
                .Paste
             
                 Set cht2 = .ChartObjects("Daily_Mail_Graph")
                 cht2.Top = .Range("B1:B40").Height
                 cht2.Left = .Range("A40:B40").Width
                 cht2.Width = .Range("B40:Q40").Width
                 cht2.Height = .Range("B40:Q69").Height]
            End With
        End With
    End With
 
End Sub

 

[Eric Penfold]

Thanks perfect

 

[Legacy 143009]

I am glad it did work. Thanks for the feedback!