Moving Excel Chart/Shape???

mikeH321 · Dec 28, 2006

I have the following code that generates an Excel chart on the worksheet that is passed to it. The creating of the chart works fine but I am having trouble moving the chart where I want to after it is created. I am passing several different worksheets through this code and it bugs out after the first sheet because I have not been able to find an effective way telling it which chart/shape I want to move. Right now I have the shape index manually coded in but only works for the first chart. Any suggestions would be helpful.

Code:

    Public Function addHeaderFooter(ByVal wrksheet As Excel.Worksheet, ByVal headerText As String, ByVal footerText As String)
   
    With wrksheet

        .PageSetup.Zoom = False
        .PageSetup.CenterHeader = headerText
        .PageSetup.CenterFooter = footerText
        .PageSetup.Orientation = xlLandscape
        .PageSetup.LeftMargin = (0.5)
        .PageSetup.RightMargin = (0.5)

    End With
   
    End Function
    
    Public Function createChart(ByRef excelapp As Excel.Application, ByRef wrksheet As Excel.Worksheet, _
    ByVal startRow As Integer, ByVal endRow As Integer)
    
    Dim eChart As Excel.Chart
    Dim chartName As String
    
    With wrksheet
    
    Set eChart = wrksheet.Parent.Charts.Add
    
    With excelapp
        
        .ActiveChart.ChartType = xlLineMarkers
        .ActiveChart.SetSourceData wrksheet.Range("G" & (startRow) & ":G" & (endRow) & ", " & "E" & (startRow) & ":E" & (endRow) & "")
        .ActiveChart.SeriesCollection(1).XValues = wrksheet.Range("B" & (startRow) & ":B" & (endRow) & "")
        .ActiveChart.SeriesCollection(1).Values = wrksheet.Range("G" & (startRow) & ":G" & (endRow) & "")
        .ActiveChart.SeriesCollection(1).Name = "=""CWT"""
        .ActiveChart.SeriesCollection(2).Values = wrksheet.Range("E" & (startRow) & ":E" & (endRow) & "")
        .ActiveChart.SeriesCollection(2).Name = "=""WEIGHT"""
        .ActiveChart.Location xlLocationAsObject, wrksheet.Name
        .ActiveChart.SeriesCollection(2).AxisGroup = 2
        
        chartName = .ActiveChart.Name
        
    End With
        
    'INCREASING SIZE OF CHART
    
    With excelapp
        
        .ActiveChart.PlotArea.Select
        
            With excelapp.Selection
    
                .Width = 300
                .Height = 130
    
            End With

    End With
    
    'ADDING TITLE TO CHART
    
    With excelapp.ActiveChart
        .HasTitle = True
        .ChartTitle.Characters.Text = "CWT"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "CWT"
        .Axes(xlValue, xlSecondary).HasTitle = True
        .Axes(xlValue, xlSecondary).AxisTitle.Characters.Text = "Weight"
    End With
    
    'ADDING LEGEND TO CHART
    
    With excelapp
    
        .ActiveChart.HasLegend = True
        .ActiveChart.Legend.Position = xlLegendPositionBottom
        
    End With
    
    'MOVING CHART BELOW FINAL LINE OF DATA
    
    With wrksheet.Shapes(2)
        
        .Top = wrksheet.Rows(endRow + 3).Top
        .Left = wrksheet.Columns(1).Left

    End With
    
    'MOVING CURSOR BACK TO FIRST CELL
    
    With wrksheet
    
        .Cells(7, 1).Select
        
    End With

    Set eChart = Nothing
    
    End With
    End Function

SkipVought · Dec 28, 2006

Hi,

Check out Charts & VBA faq707-4811

The object that is in your worksheet is a ChartObject Object. It can be referenced something like...

Code:

Set TheChart = TheSheet.ChartObjects("TheChartObjectName").Chart

or

Code:

Set TheChart = TheSheet.ChartObjects(TheChartObjectIndex).Chart

Explicitly name each ChartObject Object or refer to them in the sequence in which they were entered; 1, 2, 3...

Skip,
_[red][/red]

mikeH321 · Dec 28, 2006

Thanks for the help skip I'm think I'm on the right track to get the charts where I want them placed but now I am running into another problem. No matter what I do all of the charts are being placed on the first worksheet. I've tried about a dozen different ways to specify on which tab I want the chart based on the information I pass to the addChart function but they always end up on the first worksheet. I know this code is probably bloated but it is my first go-round and something like this. Here is my full code.

Code:

   ' DECLAIRING OBJECT VARIABLES
   
    Dim appExcel As Excel.Application
    Dim wbk As Excel.Workbook
    Dim wks As Excel.Worksheet
    Dim sOutput As String
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim sSQL As String
    Dim sheetsPerBook As Integer
    Dim borderEndRow As Integer ' USED FOR CREATING CELL BORDERS
         
   ' CONSTANTS

   Const aStartRow As Byte = 7
   Const aStartColumn As Byte = 1

   ' SET TO BREAK ON ALL ERRORS
   
   Application.SetOption "Error Trapping", 0

   ' GENERATING OUTPUT FILE NAME
   
   If formdate("S", 8) = formdate("E", 8) Then
   
        sOutput = "S:\HWYREPORTS\COL\Accounts\A\AEP\CWT REPORT " & Format(fdate(formdate("S", 8)), "mm-dd-yy") & ".xls"
   
        Else
   
        sOutput = "S:\HWYREPORTS\COL\Accounts\A\AEP\CWT REPORT " & Format(fdate(formdate("S", 8)), "mm-dd-yy") & " through " & Format(fdate(formdate("E", 8)), "mm-dd-yy") & ".xls"
   
   End If
      
   If Dir(sOutput) <> "" Then Kill sOutput
      
   ' SETTING EXCEL AND DB OBJECTS
   
   Set appExcel = New Excel.Application
   sheetsPerBook = appExcel.SheetsInNewWorkbook
   appExcel.SheetsInNewWorkbook = 4  ' SETTING NUMBER OF WORKSHEETS IN WORKBOOK
   Set wbk = appExcel.Workbooks.Add
   appExcel.SheetsInNewWorkbook = sheetsPerBook
   Set dbs = CurrentDb
   
   '***********************************************************
   '***************** ADDING DATA TO TAB (1)*******************
   '***********************************************************
   
    Set wks = wbk.Worksheets(1)
    
    wks.Activate
   
    sSQL = "SELECT * FROM CWTqryExportAlsip"
            
    Set rst = dbs.OpenRecordset(sSQL, dbOpenSnapshot)
    
    ' NAMING TAB
   
    With wbk
        
        wks.Select
        wks.Name = "ALSIP DATA"
   
    End With
   
    ' ADDING LOGO TO EXCEL FILE

    Call addImage(wks, appExcel)
    
    ' ADDING COLUMN HEADERS TO EXCEL FILE
    
    Call addColumnHeaders(wks, rst, aStartColumn, aStartRow)
    
    ' ADDING DATA TO EXCEL FILE
   
    Call addData(wks, rst, aStartRow, aStartColumn)
   
    ' AUTOFITTING COLUMNS
   
    With wks
   
        .Columns("A:AI").EntireColumn.AutoFit
        .Columns("A:AI").EntireColumn.HorizontalAlignment = xlLeft
        .Columns("A:AI").EntireColumn.VerticalAlignment = xlTop
        .Range("E:E,H:H,L:L,P:P,T:T,X:X,AB:AB,AF:AF").NumberFormat = "#,##0"
        .Range("F:F,I:I,M:M,Q:Q,U:U,Y:Y,AC:AC,AG:AG").NumberFormat = "$#,##0.00_);($#,##0.00)"
        .Range("K:K,O:O,S:S,W:W,AA:AA,AE:AE,AI:AI").NumberFormat = "0.00%"
        
    End With
    
    ' ADDING BORDERS
    
    borderEndRow = rst.RecordCount + aStartRow
    
    Call addBorder(appExcel, wks, "A", "D", aStartRow, borderEndRow)
    
    Call addBorder(appExcel, wks, "E", "G", aStartRow, borderEndRow)
    
    Call addBorder(appExcel, wks, "H", "K", aStartRow, borderEndRow)
    
    Call addBorder(appExcel, wks, "L", "O", aStartRow, borderEndRow)
        
    Call addBorder(appExcel, wks, "P", "S", aStartRow, borderEndRow)
   
    Call addBorder(appExcel, wks, "T", "W", aStartRow, borderEndRow)
    
    Call addBorder(appExcel, wks, "X", "AA", aStartRow, borderEndRow)
    
    Call addBorder(appExcel, wks, "AB", "AE", aStartRow, borderEndRow)
    
    Call addBorder(appExcel, wks, "AF", "AI", aStartRow, borderEndRow)
    
    'MOVING CURSOR BACK TO FIRST CELL
    
    'With wks
    
        '.Cells(aStartRow, aStartColumn).Select
        
    'End With
    
    'ADDING CHART TO EXCEL FILE
    
    Call createChart(appExcel, wks, aStartRow, borderEndRow, 2)
    
   ' ADDING HEADER AND FOOTER
   
   Call addHeaderFooter(wks, "AEP ALSIP CWT REPORT", "Page &p")
   
   '***********************************************************
   '***************** ADDING DATA TO TAB (2)*******************
   '***********************************************************
   
    Set wks = wbk.Worksheets(2)
    
    wks.Activate
   
    sSQL = "SELECT * FROM CWTqryExportChino"
            
    Set rst = dbs.OpenRecordset(sSQL, dbOpenSnapshot)
    
    ' NAMING TAB
   
    With wbk
        
        wks.Select
        wks.Name = "CHINO DATA"
   
    End With
   
    'ADDING LOGO TO EXCEL FILE

    Call addImage(wks, appExcel)
    
    ' ADDING COLUMN HEADERS TO EXCEL FILE
    
    Call addColumnHeaders(wks, rst, aStartColumn, aStartRow)
    
    ' ADDING DATA TO EXCEL FILE
   
    Call addData(wks, rst, aStartRow, aStartColumn)
   
    ' AUTOFITTING COLUMNS
   
    With wks
   
        .Columns("A:AI").EntireColumn.AutoFit
        .Columns("A:AI").EntireColumn.HorizontalAlignment = xlLeft
        .Columns("A:AI").EntireColumn.VerticalAlignment = xlTop
        .Range("E:E,H:H,L:L,P:P,T:T,X:X,AB:AB,AF:AF").NumberFormat = "#,##0"
        .Range("F:F,I:I,M:M,Q:Q,U:U,Y:Y,AC:AC,AG:AG").NumberFormat = "$#,##0.00_);($#,##0.00)"
        .Range("K:K,O:O,S:S,W:W,AA:AA,AE:AE,AI:AI").NumberFormat = "0.00%"
        
    End With
   
    ' ADDING BORDERS
    
    borderEndRow = rst.RecordCount + aStartRow
    
    Call addBorder(appExcel, wks, "A", "D", aStartRow, borderEndRow)
    
    Call addBorder(appExcel, wks, "E", "G", aStartRow, borderEndRow)
    
    Call addBorder(appExcel, wks, "H", "K", aStartRow, borderEndRow)
    
    Call addBorder(appExcel, wks, "L", "O", aStartRow, borderEndRow)
        
    Call addBorder(appExcel, wks, "P", "S", aStartRow, borderEndRow)
   
    Call addBorder(appExcel, wks, "T", "W", aStartRow, borderEndRow)
    
    Call addBorder(appExcel, wks, "X", "AA", aStartRow, borderEndRow)
    
    Call addBorder(appExcel, wks, "AB", "AE", aStartRow, borderEndRow)
    
    Call addBorder(appExcel, wks, "AF", "AI", aStartRow, borderEndRow)
    
    'ADDING CHART TO EXCEL FILE

    Call createChart(appExcel, wks, aStartRow, borderEndRow, 3)
    
   'MOVING CURSOR BACK TO FIRST CELL
    
    'With wks
    
        '.Cells(aStartRow, aStartColumn).Select
        
    'End With
      
   ' ADDING HEADER AND FOOTER
   
    Call addHeaderFooter(wks, "AEP CHINO CWT REPORT", "Page &p")
   
    '***********************************************************
    '***************** ADDING DATA TO TAB (3)*******************
    '***********************************************************
   
    Set wks = wbk.Worksheets(3)
    
    wks.Activate
   
    sSQL = "SELECT * FROM CWTqryExportGriffin"
            
    Set rst = dbs.OpenRecordset(sSQL, dbOpenSnapshot)
    
    ' NAMING TAB
   
    With wbk
        
        wks.Select
        wks.Name = "GRIFFIN DATA"
   
    End With
   
    'ADDING LOGO TO EXCEL FILE

    Call addImage(wks, appExcel)
    
    ' ADDING COLUMN HEADERS TO EXCEL FILE
    
    Call addColumnHeaders(wks, rst, aStartColumn, aStartRow)
    
    ' ADDING DATA TO EXCEL FILE
   
    Call addData(wks, rst, aStartRow, aStartColumn)
   
    ' AUTOFITTING COLUMNS
   
    With wks
   
        .Columns("A:AI").EntireColumn.AutoFit
        .Columns("A:AI").EntireColumn.HorizontalAlignment = xlLeft
        .Columns("A:AI").EntireColumn.VerticalAlignment = xlTop
        .Range("E:E,H:H,L:L,P:P,T:T,X:X,AB:AB,AF:AF").NumberFormat = "#,##0"
        .Range("F:F,I:I,M:M,Q:Q,U:U,Y:Y,AC:AC,AG:AG").NumberFormat = "$#,##0.00_);($#,##0.00)"
        .Range("K:K,O:O,S:S,W:W,AA:AA,AE:AE,AI:AI").NumberFormat = "0.00%"
        
    End With
   
    ' ADDING BORDERS
    
    borderEndRow = rst.RecordCount + aStartRow
    
    Call addBorder(appExcel, wks, "A", "D", aStartRow, borderEndRow)
    
    Call addBorder(appExcel, wks, "E", "G", aStartRow, borderEndRow)
    
    Call addBorder(appExcel, wks, "H", "K", aStartRow, borderEndRow)
    
    Call addBorder(appExcel, wks, "L", "O", aStartRow, borderEndRow)
        
    Call addBorder(appExcel, wks, "P", "S", aStartRow, borderEndRow)
   
    Call addBorder(appExcel, wks, "T", "W", aStartRow, borderEndRow)
    
    Call addBorder(appExcel, wks, "X", "AA", aStartRow, borderEndRow)
    
    Call addBorder(appExcel, wks, "AB", "AE", aStartRow, borderEndRow)
    
    Call addBorder(appExcel, wks, "AF", "AI", aStartRow, borderEndRow)
    
    'MOVING CURSOR BACK TO FIRST CELL
    
    With wks
    
        .Cells(aStartRow, aStartColumn).Select
        
    End With
        
   ' ADDING HEADER AND FOOTER
   
    Call addHeaderFooter(wks, "AEP GRIFFIN CWT REPORT", "Page &p")
   
    '***********************************************************
    '***************** ADDING DATA TO TAB (4)*******************
    '***********************************************************
   
    Set wks = wbk.Worksheets(4)
    
    wks.Activate
   
    sSQL = "SELECT * FROM CWTqryExportWaxahachie"
            
    Set rst = dbs.OpenRecordset(sSQL, dbOpenSnapshot)
    
    ' NAMING TAB
   
    With wbk
        
        wks.Select
        wks.Name = "WAXAHACHIE DATA"
   
    End With
   
    'ADDING LOGO TO EXCEL FILE

    Call addImage(wks, appExcel)
    
    ' ADDING COLUMN HEADERS TO EXCEL FILE
    
    Call addColumnHeaders(wks, rst, aStartColumn, aStartRow)
    
    ' ADDING DATA TO EXCEL FILE
   
    Call addData(wks, rst, aStartRow, aStartColumn)
   
    ' AUTOFITTING COLUMNS
   
    With wks
   
        .Columns("A:AI").EntireColumn.AutoFit
        .Columns("A:AI").EntireColumn.HorizontalAlignment = xlLeft
        .Columns("A:AI").EntireColumn.VerticalAlignment = xlTop
        .Range("E:E,H:H,L:L,P:P,T:T,X:X,AB:AB,AF:AF").NumberFormat = "#,##0"
        .Range("F:F,I:I,M:M,Q:Q,U:U,Y:Y,AC:AC,AG:AG").NumberFormat = "$#,##0.00_);($#,##0.00)"
        .Range("K:K,O:O,S:S,W:W,AA:AA,AE:AE,AI:AI").NumberFormat = "0.00%"
        
    End With
   
    ' ADDING BORDERS
    
    borderEndRow = rst.RecordCount + aStartRow
    
    Call addBorder(appExcel, wks, "A", "D", aStartRow, borderEndRow)
    
    Call addBorder(appExcel, wks, "E", "G", aStartRow, borderEndRow)
    
    Call addBorder(appExcel, wks, "H", "K", aStartRow, borderEndRow)
    
    Call addBorder(appExcel, wks, "L", "O", aStartRow, borderEndRow)
        
    Call addBorder(appExcel, wks, "P", "S", aStartRow, borderEndRow)
   
    Call addBorder(appExcel, wks, "T", "W", aStartRow, borderEndRow)
    
    Call addBorder(appExcel, wks, "X", "AA", aStartRow, borderEndRow)
    
    Call addBorder(appExcel, wks, "AB", "AE", aStartRow, borderEndRow)
    
    Call addBorder(appExcel, wks, "AF", "AI", aStartRow, borderEndRow)
    
    'MOVING CURSOR BACK TO FIRST CELL
    
    With wks
    
        .Cells(aStartRow, aStartColumn).Select
        
    End With
        
   ' ADDING HEADER AND FOOTER
   
    Call addHeaderFooter(wks, "AEP WAXAHACHIE CWT REPORT", "Page &p")
    
    'ACTIVATING FIRST TAB IN WORKBOOK
    
    Set wks = wbk.Worksheets(1)
    
    wks.Activate
   
    'CLOSING AND SAVING NEW FILES
           
    Set wks = Nothing
    
    wbk.SaveAs FileName:=sOutput, FileFormat:= _
            xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
            , CreateBackup:=False
    
    wbk.Close SaveChanges:=False

    Set wbk = Nothing
        
    appExcel.Quit
        
    Set appExcel = Nothing
    Set dbs = Nothing
    Set rst = Nothing

   'Call AutoEmailAll("SPNEM - tblDistList", "Attached is the SP News Exception Report.  If the report is blank, there were no exceptions entered.", "SP News Exception Memo Report", sOutput)
   
ExitProcedure:
    

ErrHandler:
    Select Case Err.Number
        Case Else
            Call UnexpectedError(Err.Number, "ecSPNEM:  " _
                    & Err.Description, Err.Source, _
                    Err.HelpFile, Err.HelpContext)
            Resume ExitProcedure
            Resume
    End Select
   
   End Sub

    Public Function addBorder(ByVal excelapp As Excel.Application, ByVal wrkSheet As Excel.Worksheet, ByVal column1 As String, ByVal column2 As String, ByVal startRow As String, ByVal endRow As Integer)
    
    With wrkSheet
    
        .Range(column1 & startRow & ":" & column2 & (endRow - 1) & "").Select
            excelapp.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
            excelapp.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    
        With excelapp.Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
    
        With excelapp.Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
    
        With excelapp.Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
    
        With excelapp.Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
    
        excelapp.Selection.Borders(xlInsideVertical).LineStyle = xlNone
        excelapp.Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    
    End With
    
    End Function
        
    Public Function addColumnHeaders(ByVal wrkSheet As Excel.Worksheet, recSet As DAO.Recordset, startColumn As Byte, startRow As Byte)
    
    ' ADDING COLUMN HEADERS TO EXCEL FILE
    
    With wrkSheet
    
    Dim iCol As Integer
    Dim iRow As Integer
    Dim iFld As Integer
    Dim lRecords As Long
           
    iCol = startColumn
    iRow = (startRow - 1)
   
    If Not recSet.BOF Then recSet.MoveFirst
   
        iFld = 0
        lRecords = lRecords + 1
      

            For iCol = startColumn To startColumn + (recSet.Fields.Count - 1)
            
                .Cells(iRow, iCol) = recSet.Fields(iFld).Name
                .Cells(iRow, iCol).Interior.ColorIndex = 1
                .Cells(iRow, iCol).Font.ColorIndex = 2
                .Cells(iRow, iCol).Font.Bold = True
                        
                iFld = iFld + 1
        
                    Next
              
                        iRow = iRow + 1
                        recSet.MoveNext

    End With
    
    End Function
    
    Public Function addImage(ByVal wrkSheet As Excel.Worksheet, ByVal excelapp As Excel.Application)
    
    With wrkSheet.Pictures.Insert("S:\HWYREPORTS\Libraries\Logos\aep1.GIF")
        
        '.ShapeRange.Height = 160 (NO IMAGING RESIZING REQUIRED)
        '.ShapeRange.Width = 475  (NO IMAGING RESIZING REQUIRED)
        .Placement = xlFreeFloating
        .PrintObject = True
        
    End With
         
    With wrkSheet
    
        excelapp.Rows("7").Activate
        excelapp.ActiveWindow.FreezePanes = True
    
    End With
    
    End Function
    
    Public Function addData(ByVal wrkSheet As Excel.Worksheet, ByVal recSet As DAO.Recordset, ByVal startRow As Byte, ByVal startColumn As Byte)
    
    Dim iCol As Integer
    Dim iRow As Integer
    Dim iFld As Integer
    Dim lRecords As Long
    Dim highLight As Boolean
    
    iCol = startColumn
    iRow = startRow
    highLight = False
   
    With wrkSheet
   
    If Not recSet.BOF Then recSet.MoveFirst
        
    Do Until recSet.EOF
    
    iFld = 0
    lRecords = lRecords + 1
         
        For iCol = startColumn To startColumn + (recSet.Fields.Count - 1)
            
            .Cells(iRow, iCol) = "" & recSet.Fields(iFld)
                       
        '***** THE FOLLOWING LINES CAN BE USED TO ALTERNATE CELL BACKGROUND COLORS ON ALTERNATE ROWS *****
            'If highLight = True Then
            
                'wks.Cells(iRow, iCol).Interior.ColorIndex = 15
            
            'End If
        '*************************************************************************************************
                            
            iFld = iFld + 1
        
                Next
                
                    iRow = iRow + 1
                    recSet.MoveNext
                    
                    If highLight = False Then
                    
                        highLight = True
                        
                            Else
                                
                                highLight = False
                    End If
   
        Loop
   
    End With

    End Function
    
    Public Function addHeaderFooter(ByVal wrkSheet As Excel.Worksheet, ByVal headerText As String, ByVal footerText As String)
   
    With wrkSheet

        .PageSetup.Zoom = False
        .PageSetup.CenterHeader = headerText
        .PageSetup.CenterFooter = footerText
        .PageSetup.Orientation = xlLandscape
        .PageSetup.LeftMargin = (0.5)
        .PageSetup.RightMargin = (0.5)

    End With
   
    End Function
    
    Public Function createChart(ByVal excelapp As Excel.Application, wrkSheet As Excel.Worksheet, _
    ByVal startRow As Integer, ByVal endRow As Integer, ByVal chartNumber As Integer)

    Dim eChart As Excel.Chart
  
    With wrkSheet
    
    Set eChart = wrkSheet.Parent.Charts.Add
    
    End With
    
    With excelapp
        
        .ActiveChart.ChartType = xlLineMarkers
        .ActiveChart.SetSourceData wrkSheet.Range("G" & (startRow) & ":G" & (endRow) & ", " & "E" & (startRow) & ":E" & (endRow) & "")
        .ActiveChart.SeriesCollection(1).XValues = wrkSheet.Range("B" & (startRow) & ":B" & (endRow) & "")
        .ActiveChart.SeriesCollection(1).Values = wrkSheet.Range("G" & (startRow) & ":G" & (endRow) & "")
        .ActiveChart.SeriesCollection(1).Name = "=""CWT"""
        .ActiveChart.SeriesCollection(2).Values = wrkSheet.Range("E" & (startRow) & ":E" & (endRow) & "")
        .ActiveChart.SeriesCollection(2).Name = "=""WEIGHT"""
        .ActiveChart.Location xlLocationAsObject, wrkSheet.Name
        .ActiveChart.SeriesCollection(2).AxisGroup = 2
        
    End With
        
    'INCREASING SIZE OF CHART
    
    With excelapp
        
        .ActiveChart.PlotArea.Select
        
            With excelapp.Selection
    
                .Width = 300
                .Height = 130
    
            End With

    End With
    
    'ADDING TITLE TO CHART
    
    With excelapp.ActiveChart
        
        .HasTitle = True
        .ChartTitle.Characters.Text = "CWT"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "CWT"
        .Axes(xlValue, xlSecondary).HasTitle = True
        .Axes(xlValue, xlSecondary).AxisTitle.Characters.Text = "Weight"
        
    End With
    
    'ADDING LEGEND TO CHART
    
    With excelapp
        
        .ActiveChart.HasLegend = True
        .ActiveChart.Legend.Position = xlLegendPositionBottom
        
    End With
    
    'MOVING CHART BELOW FINAL LINE OF DATA
    
    'With wrkSheet.Shapes(chartNumber)
        
        '.Top = wrkSheet.Rows(endRow + 3).Top
        '.Left = wrkSheet.Columns(1).Left

    'End With

    Set eChart = Nothing
    
    End Function

SkipVought · Dec 28, 2006

Code:

Set co = Sheets("Sheet1").ChartObjects.Add(50, 40, 200, 100)
    Dim eChartObj As Excel.ChartObject
  
    With wrkSheet
    
       Set eChartObj = .ChartObjects.Add iLeft, iTop, iWidth, iHeight
       
    End With
    with eChartObj
       'manipulate the ChartObject Properties here
...
       with .Chart
          'manipulate the Chart properties here
...
       end with
    end with

Skip,
_[red][/red]

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Moving Excel Chart/Shape???

mikeH321

Programmer

SkipVought

Programmer

mikeH321

Programmer

SkipVought

Programmer

Similar threads

Part and Inventory Search

Sponsor