vba chart creation on a new worksheet

Giorgio · Jan 19th 2005

I'm having problems with a spreadsheet trying to create a new spreadsheet and then creating a new chart. I seems to have corrupted the code but I can't figure out what has happened. (i performed the ultimate crime and saved over my original code) doh!!!!!!!!

Any help would be gratefully appreciated.

Code

Sub New_Chart()


Dim wkbTemplate As Workbook
Dim wbk As Workbook
Dim wksControl As Worksheet
Dim wksCountry As Worksheet
Dim wksNewSheet As Worksheet
Dim chtActive As Chart


Dim i As Integer
Dim j As Integer
Dim nRows As Integer
Dim strCountry As String
Dim strSheetName As String


ActiveWorkbook.SaveAs Filename = "C:\Co182_gf_A" & i & ".xls"
Set wkb = ActiveWorkbook
Set wksControl = wkb.Worksheets("all")
Set wksCountry = wkb.Worksheets("sheet1")


i = 2
For i = 2 To 20 'test actual figure is 180


strCountry = wksControl.Cells(1, i).Value
strSheetName = wksControl.Cells(1, i).Value


    Set wksNewSheet = wkb.Worksheets.Add
    wksNewSheet.Name = strSheetName
    wksNewSheet.Move after:=Sheets(wkb.Worksheets.Count - 1)
    wksCountry.Select
    wksCountry.Cells.Select
    Selection.Copy
    wksNewSheet.Select
    wksNewSheet.Paste


    '*** Paste country name into sheet
    wksNewSheet.Cells(6, 1).Value = wksControl.Cells(1, i).Value
Debug.Print strCountry
    '*** Change series for charts
    Range("B5:C38").Select
    Selection.Copy
    
    Range("E5").Select
    Selection.PasteSpecial Paste:=xlValues
    
    '*** CHART
    Range("E6:F38").Select
    Selection.Sort Key1:=Range("F6"), Order1:=xlDescending, Header:=xlNo, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    
    Charts.Add
    ActiveChart.ChartType = xlBarStacked
    ActiveChart.SetSourceData Source:=Cells("& strsheetname &"! E5:F38")
    ActiveChart.Name = "& strsheetname & & 1 &"
    ActiveChart.Location Where:=xlLocationAsObject, Name:=strSheetName
    ActiveChart.HasLegend = False
    ActiveSheet.Shapes.strSheetName.IncrementLeft 19.5
    ActiveSheet.Shapes.strSheetName.IncrementTop -84.75
    ActiveSheet.Shapes.strSheetName.ScaleWidth 1.28, msoFalse, msoScaleFromTopLeft
    ActiveSheet.Shapes.strSheetName.ScaleHeight 1.63, msoFalse, msoScaleFromTopLeft
    ActiveChart.PlotArea.Select
    With Selection.Border
        .ColorIndex = 16
        .Weight = xlThin
        .LineStyle = xlContinuous
    End With
    
    With Selection.TickLabels.Font
        .Name = "Foundry Form Sans"
        .Size = 10
    End With
    
    With Selection.TickLabels.Font
        .Name = "Foundry Form Sans"
        .Size = 8
    End With
        
    With Selection.TickLabels.Font
        .Name = "Foundry Form Sans"
        .Size = 10
    End With
    
    With Selection.TickLabels
        .Alignment = xlCenter
        .Offset = 100
        .Orientation = xlUpward
    End With


    '*** page setup here
    With wksNewSheet.PageSetup
    wksNewSheet.PageSetup.Orientation = xlLandscape
        .LeftMargin = Application.InchesToPoints(0.78740157480315)
        .RightMargin = Application.InchesToPoints(0.31496062992126)
        .TopMargin = Application.InchesToPoints(0.511811023622047)
        .BottomMargin = Application.InchesToPoints(0.590551181102362)
        .HeaderMargin = Application.InchesToPoints(0.511811023622047)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
    
    End With
    ActiveWindow.View = xlPageBreakPreview
    wksNewSheet.PageSetup.PrintArea = "$e$1:$p$38"


    wkb.Save
    wkb.Close
    
    Exit For


Next i


  
End Sub

Display More

**Andy Pope** · Jan 19th 2005

Re: vba chart creation on a new worksheet

Hi Giorgio,

The code now generates a chart. I have included comments where I have changed the code.

Code

Sub New_Chart()
     
    Dim wkbTemplate As Workbook
    Dim wbk As Workbook
    Dim wksControl As Worksheet
    Dim wksCountry As Worksheet
    Dim wksNewSheet As Worksheet
    Dim chtActive As Chart
     
    Dim i As Integer
    Dim j As Integer
    Dim nRows As Integer
    Dim strCountry As String
    Dim strSheetName As String
     
    ' : missing from argument
    ' i is zero ??
    ActiveWorkbook.SaveAs Filename:="C:\Co182_gf_A" & i & ".xls"
    ' wbk variable mis-spelt wkb
    Set wbk = ActiveWorkbook
    Set wksControl = wbk.Worksheets("all")
    Set wksCountry = wbk.Worksheets("sheet1")
     
    i = 2
    For i = 2 To 20 'test actual figure is 180
         
        strCountry = wksControl.Cells(1, i).Value
        strSheetName = wksControl.Cells(1, i).Value
         
        Set wksNewSheet = wbk.Worksheets.Add
        wksNewSheet.Name = strSheetName
        wksNewSheet.Move after:=Sheets(wbk.Worksheets.Count - 1)
        wksCountry.Select
        wksCountry.Cells.Select
        Selection.Copy
        wksNewSheet.Select
        wksNewSheet.Paste
         
         '*** Paste country name into sheet
        wksNewSheet.Cells(6, 1).Value = wksControl.Cells(1, i).Value
        Debug.Print strCountry
         '*** Change series for charts
        Range("B5:C38").Select
        Selection.Copy
         
        Range("E5").Select
        Selection.PasteSpecial Paste:=xlValues
         
         '*** CHART
        Range("E6:F38").Select
        Selection.Sort Key1:=Range("F6"), Order1:=xlDescending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
         
        Charts.Add
        ' column chart as your example
        ActiveChart.ChartType = xlColumnClustered ' xlBarStacked
        ' range NOT Cells and quotes/variable not correct
        ActiveChart.SetSourceData Source:=Range(strSheetName & "! E6:F38")
        ActiveChart.Name = "& strsheetname & & 1 &"
        ActiveChart.Location Where:=xlLocationAsObject, Name:=strSheetName
        ActiveChart.HasLegend = False
        ' use ()Index not . reference
        ActiveSheet.Shapes(strSheetName).IncrementLeft 19.5
        ActiveSheet.Shapes(strSheetName).IncrementTop -84.75
        ActiveSheet.Shapes(strSheetName).ScaleWidth 1.28, msoFalse, msoScaleFromTopLeft
        ActiveSheet.Shapes(strSheetName).ScaleHeight 1.63, msoFalse, msoScaleFromTopLeft
        ActiveChart.PlotArea.Select
        With Selection.Border
            .ColorIndex = 16
            .Weight = xlThin
            .LineStyle = xlContinuous
        End With
        ' not selection. Need to reference Axis
        With ActiveChart.Axes(1, xlPrimary).TickLabels.Font
            .Name = "Foundry Form Sans"
            .Size = 10
        End With
         
        With ActiveChart.Axes(2, xlPrimary).TickLabels.Font
            .Name = "Foundry Form Sans"
            .Size = 10
        End With
         
        With ActiveChart.Axes(1, xlPrimary).TickLabels
            .Alignment = xlCenter
            .Offset = 100
            .Orientation = xlUpward
        End With
         
         '*** page setup here
        With wksNewSheet.PageSetup
            wksNewSheet.PageSetup.Orientation = xlLandscape
            .LeftMargin = Application.InchesToPoints(0.78740157480315)
            .RightMargin = Application.InchesToPoints(0.31496062992126)
            .TopMargin = Application.InchesToPoints(0.511811023622047)
            .BottomMargin = Application.InchesToPoints(0.590551181102362)
            .HeaderMargin = Application.InchesToPoints(0.511811023622047)
            .FooterMargin = Application.InchesToPoints(0.31496062992126)
             
        End With
        'ActiveWindow.View = xlPageBreakPreview
        wksNewSheet.PageSetup.PrintArea = "$e$1:$p$38"
         
'        wbk.Save
'        wbk.Close
         
        Exit For
         
    Next i
     
     
End Sub

Display More

Giorgio · Jan 19th 2005

Re: vba chart creation on a new worksheet

Thanks I feel as if a bus has run me over, can't imagine what was going on in my head to screw this macro up so badly in such a little amount of time. I will be eternally grateful for your help....

p.s. did I say it works. many thanks

vba chart creation on a new worksheet

Participate now!

Share