using code to create Excel CHART objects. 1

[jackal63]

Hi, I have an Excel spreadsheet with information that is pulled in from Access using MS Query, then a fuction is ran to format the info. uniformly.

What I need to know now is how to write a VBA function that will allow me to create and assign properties such as data ranges, position etc. to Excel Charts.

I looked through the MS Help in Excel, but any information that it gave didn't have anything to do with using code. I KNOW there has to be a relativly simple way to do it, I just don't know what that is

Any help on this topic would be GREATLY appreciated.
Thank you.

 

[Chance1234]

Hi below is some code ive written which shoudl give you some idea on the coding behin ms excel chart

Public Function pfunCreatEGraphs(chkd(), chkID) As String
Dim i As Integer
Dim WrkApp As Excel.Application
Dim Wrkbknew As Workbook
Dim WrkShtNew As Worksheet

Dim StrSql As String
Dim Rst As Recordset
Dim FlDcO(3) As String
Dim LpC As Integer

Dim intco As Integer
Dim IntcoL As String

Dim ChtNew As Chart


Dim strb, strc As String

'On Error GoTo ErrTrap

'-------------------Excel Add----------------

Set WrkApp = CreateObject("Excel.application&quot
Set Wrkbknew = WrkApp.Workbooks.Add

'Wrkbknew.Application.Visible = True

'----------****************** LOOP ***************************

LpC = 1
i = 1

Do Until LpC = UBound(chkd) + 1
Set WrkShtNew = Wrkbknew.Worksheets.Add
WrkShtNew.Name = chkd(LpC)

'--****-----Call Functions for SQL
StrSql = pfunWhAtSqL(chkd(LpC), chkID)
FlDcO(1) = pfunWhAtcolumns(chkd(LpC), 1)
FlDcO(2) = pfunWhAtcolumns(chkd(LpC), 2)
FlDcO(3) = pfunWhAtcolumns(chkd(LpC), 3)
intco = pfunHowmanycolumns(chkd(LpC))

'--****----------------------------

'---** Connect TO Data **------------------
psubUserConnect
Set Rst = objUserConnection.Execute(StrSql)

'--**POPULATE NEW SHEET WITH DATA FROM RST **____________
Do Until Rst.EOF = True
Select Case intco

Case 1

Wrkbknew.Sheets(chkd(LpC)).Cells(i, 1) = Rst.Fields(2)
Wrkbknew.Sheets(chkd(LpC)).Cells(i, 2) = 0 + Rst.Fields(FlDcO(1))
i = i + 1
IntcoL = "B"

Case 2
Wrkbknew.Sheets(chkd(LpC)).Cells(i, 1) = Rst.Fields(2)
Wrkbknew.Sheets(chkd(LpC)).Cells(i, 2) = 0 + Rst.Fields(FlDcO(1))
Wrkbknew.Sheets(chkd(LpC)).Cells(i, 3) = 0 + Rst.Fields(FlDcO(2))
i = i + 1
IntcoL = "C"
Case 3
Wrkbknew.Sheets(chkd(LpC)).Cells(i, 1) = Rst.Fields(2)
Wrkbknew.Sheets(chkd(LpC)).Cells(i, 2) = 0 + Rst.Fields(FlDcO(1))
Wrkbknew.Sheets(chkd(LpC)).Cells(i, 3) = 0 + Rst.Fields(FlDcO(2))
Wrkbknew.Sheets(chkd(LpC)).Cells(i, 4) = 0 + Rst.Fields(FlDcO(3))
i = i + 1
IntcoL = "D"
End Select

Rst.MoveNext
Loop
'------------------

'**** CREATE CHART ****----------------


If i > 1 Then

Set ChtNew = Wrkbknew.Charts.Add

strc = "A1:" & IntcoL & i - 1

With ChtNew
.ChartType = xlColumnClustered
.SetSourceData Source:=Sheets(chkd(LpC)).Range(strc), PlotBy:=xlColumns
.Location WHERE:=xlLocationAsObject, Name:=chkd(LpC)
End With

End If

'----********** Clear Up
Set WrkShtNew = Nothing
Set ChtNew = Nothing

StrSql = ""
intco = 0
strb = ""
strc = ""
i = 1
psubUserDisconnect

'=--------Loop counter increase

LpC = LpC + 1

Loop


Dim FilNm As String
Dim rndIn As Integer

Randomize
rndIn = Int((20 * Rnd) + 1)


FilNm = "C:\temp\da" & rndIn & ".xls"



Wrkbknew.SaveAs FileName:=FilNm
Wrkbknew.Close
WrkApp.Quit


Set ChtNew = Nothing
Set WrkShtNew = Nothing
Set WrkApp = Nothing


StrSql = ""
intco = 0
strb = ""
strc = ""
psubUserDisconnect



pfunCreatEGraphs = FilNm

Exit Function


End Function

Public Function GetdatAfromExcel(pPf As Presentation, chkd(), flPath As String)

Dim Wrkbk As Workbook
Dim WrkSht As Worksheet
Dim ChtEx As Chart
Dim Pnew As Slide
Dim Y As Integer
Dim fntSz As Integer

'-------------Dims for frmt
Dim a, b As String
Dim C As Integer

'***************************************************
Set Wrkbk = GetObject(flPath)

'****************For next loop to move through the worksheets

For Each WrkSht In Wrkbk.Worksheets
Set a = WrkSht.Cells.SpecialCells(xlCellTypeLastCell)
C = a.Row

Debug.Print C & " TH"
'***********************FONT SIZE FOR AXIS
If C > 110 Then
fntSz = 6
Else
fntSz = 8
End If
'*********************

b = a.Address(ReferenceStyle:=xlR1C1)
b = Left(b, Len(b) - 1)
b = b & "1"
b = "R1C1:" & b ' range for labels

'******* Test for charts
If WrkSht.ChartObjects.Count > 0 Then
'with Chart
With WrkSht.ChartObjects(1).Chart 'anything to do with chart straight
.HasLegend = False
.ChartArea.Border.LineStyle = 0
.PlotArea.Interior.ColorIndex = xlNone
.PlotArea.Border.LineStyle = xlNone
.SeriesCollection(1).XValues = "='" & WrkSht.Name & "'!" & b & ""
.SeriesCollection(1).Interior.ColorIndex = 37

With .Axes(xlCategory)
.HasTitle = False
.TickLabelSpacing = 1
' .MajorUnit = XScUni 'look here
With .TickLabels
' .TickLabelSpacing = 1
.AutoScaleFont = False
.Alignment = xlCenter
.Offset = 100
.Orientation = xlUpward
With .Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With
End With
End With
'*******************************
With .Axes(xlValue)
.HasTitle = True
.AxisTitle.Text = pfunWhatAxislabel(WrkSht.Name)
.HasMajorGridlines = False
.HasMinorGridlines = False
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
.MaximumScaleIsAuto = True
With .TickLabels
.AutoScaleFont = False
With .Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = fntSz
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With
End With
End With
End With

With WrkSht.ChartObjects(1)
.Height = 349
.Width = 780
.Chart.ChartGroups(1).GapWidth = 50

Select Case .Chart.SeriesCollection.Count

Case 2
.Chart.SeriesCollection(2).Interior.ColorIndex = 1
.Chart.HasLegend = True
.Chart.Legend.Position = xlTop
.Chart.Legend.Font.Size = 8
.Chart.SeriesCollection(1).Name = "Initial Weight"
.Chart.SeriesCollection(2).Name = "Optimised Weight"


Case 3
.Chart.SeriesCollection(2).Interior.ColorIndex = 1
.Chart.ChartGroups(1).Overlap = 100
.Chart.SeriesCollection(3).AxisGroup = 2
.Chart.SeriesCollection(3).ChartType = xlLine
.Chart.SeriesCollection(3).Border.ColorIndex = 3
.Chart.Axes(xlValue, xlSecondary).TickLabels.Font.Size = 8
.Chart.HasLegend = True
.Chart.Legend.Position = xlTop
.Chart.Legend.Font.Size = 8
.Chart.SeriesCollection(1).Name = "Stand Alone"
.Chart.SeriesCollection(2).Name = "Diversified"
.Chart.SeriesCollection(3).Name = "Diversity Score"
End Select

End With


WrkSht.ChartObjects(1).CopyPicture

'***************************************************************
x = pPf.Slides.Count + 1

Set Pnew = pPf.Slides.Add(x, ppLayoutTitle)
Pnew.Shapes.Title.TextFrame.TextRange.Text = WrkSht.Name

Pnew.Shapes.Paste
With Pnew.Shapes("Rectangle 2&quot
.Height = 36
.Width = 692
.Left = 41
.Top = 18
.TextFrame.TextRange.Font.Size = 24
.TextFrame.TextRange.Font.Name = "ARIAL"
.TextFrame.TextRange.Font.Bold = msoCTrue
End With

Pnew.Shapes(2).Delete
With Pnew.Shapes(2)
.Height = 349
.Width = 780
.Left = 0
.Top = 108
End With
Pnew.Name = WrkSht.Name
End If

Next

Wrkbk.Save
Wrkbk.Close

End Function

 

[SkipVought]

Hi, jackal63,
Probably the best way to START, is to take your imported data and do a macro record while creating a chart via the chart wizard. It may take you several passes, but you will be able to see the code that is generated. The code will have to be modified to make it more general, but that can come later.

After you generate some of the pieces of code that you might need, then come back here and post specific questions about putting it together.

The answers to your question can ALL be answered in this manner. It's a GREAT learning tool, along with On-line Help.

Hope this helps - catch ya later Skip,
metzgsk@voughtaircraft.com

 

[jackal63]

chance, thanks for the code, and skip, that's the greatest trick ever. Can't believe I didn't think of that, really usefull for anything, thanks.

 

[jackal63]

having been having some good luck, generated the proper series of chart that make up the mandated reports. The only prolbem Im having now is how to properly position the charts on creation, so all these charts Im generating appear on the proper reports. When you manually move and resize the chart, it seems to call left increment and size ratio methods, but these are dependant on the initial creation point of hte chart. I would like to find an absolute positioning method that can be called on creation, like origin_x, origin_y, height, width properties that can be edited. I thought maybe these where contained in teh activechart.shapes property, but couldn't find anything applicable.

Has anybody else had any luck with this, or any suggestions?

 

[SkipVought]

Hi,
When you .Add an object on a sheet or a form, there are default values for .Left, .Top, .Width & .Height. You can set these explicitly. Skip,
metzgsk@voughtaircraft.com

 

[jackal63]

Thanks. The original command I was using, chart.add, that I was given from the macro I recorded, didn't have these properties. After digging around for a bit I found that chartobject.add had these properties. Now I just have to play around a bit to get the chart options to work again.

 

[SkipVought]

Jackal63,
What you are doing is one of the greatest learing methods. But feel free to come to Tek-Tips and ask questions. There are lots of experienced contributors who just can't wait to sink their teeth into a knotty problem waiting to become a stellar solution.

Another helpful tool in the VB editor is the Object Browser. Here you can search for objects, properties, methods and see just what library they are associated with and what other properties and methods might be available.

Your available objects and tools can be further expanded, if appropriate, by adding a Reference to another library in menu item - Tools/References.

Glad to see you are progressing. Skip,
metzgsk@voughtaircraft.com

 

[jackal63]

Been having some luck, almost done with my report application, hopefully. I just want to get back into web design for while, we've got a re-design scheduled for second quarter.

Anyways, all I have to do is figure out how to make the code dynamically assign the differant ranges to charts as the program cycles through the all the reports. As an example :

Set co1 = Sheets("Report&quot.ChartObjects.Add(3, 20 + GraphOff, 523, 243)
With co1.Chart
.SeriesCollection.NewSeries
.SeriesCollection.NewSeries
.SeriesCollection.NewSeries
.SeriesCollection(1).XValues = "=Calc!R1C3:R13C3"
.SeriesCollection(1).Values = "=Calc!R1C5:R13C5"
.SeriesCollection(1).Name = "Day Shift"

the "Calc!R1C5:R13C5" explicitly assigns the range that's supposed to go into series 1 of the first chart. The charts are generated in a loop, obviously the next report has to have a differant range in it, "Calc!R14C5:R26C5". So that's the last problem Im trying to figure out, trying to concatenate a string from the address of an offset, but that doesn't seem to be allowed, this example code gives me an error:

Sub Macro2()
Dim bob As Variant
bob = Worksheets("Calc&quot.Range(myobject.Address).Offset
(0, 9).Address(ReferenceStyle:=xlR1C1)

End Sub

Run time error 424 : Object Required.

Oh well, thanks for all the help. I've still got all day tomorrow to muddle through this. If you have any ideas, offcourse I would greatly appreciate it.

 

[SkipVought]

Jackal63,

Here's some code for looping thru a borkbook, grabbing chartobjects and pasting them into powerpoint...

Sub CreatePresentation()
    Dim PowerPointObject As Object, wbk As Workbook, iChart As Integer, iSlideCount As Integer
    'Create a PowerPoint Object
    Set wbk = ActiveWorkbook
    Set PowerPointObject = CreateObject("PowerPoint.Application")
    'Open PowerPoint object
    PowerPointObject.Visible = True
    'Open the file in PowerPoint
    PowerPointObject.Presentations.Open Filename:="D:/test.ppt"
    iChart = 0
    wbk.Activate
    For Each Worksheet In Worksheets
        For Each ChartObject In Worksheet.ChartObjects
            iChart = iChart + 1
            ChartObject.Copy
'            ChartObject.ChartArea.Copy
            PowerPointObject.Activate
            With PowerPointObject
                iSlideCount = .ActivePresentation.Slides.Count
                If iChart > 1 Then
                    iSlideCount = iSlideCount + 1
                    .ActivePresentation.Slides.Add iSlideCount, Layout:=ppLayoutBlank
                End If
                .ActiveWindow.View.GotoSlide Index:=iSlideCount
                With .ActiveWindow
                    .View.Paste
                    With .Selection.ShapeRange
                        .Left = 183.75
                        .Top = 183#
                        .Width = 352.5
                        .Height = 174#
                    End With
                End With
            End With
            wbk.Activate
        Next
    Next
    
    PowerPointObject.Quit
    Set PowerPointObject = Nothing
End Sub

Hope this helps Skip,
metzgsk@voughtaircraft.com

 

[godfrey62]

To all,
Skip helped me with a posting about four charts I had positioned on a worksheet in Excel that looked at source data on four separate worksheets in the same workbook. One thing we had trouble with inside Excel was the axes changing size and moving around. We went to each chart and set a specific axis setting for the four charts (took the checkmark off the AUTOMATIC setting) and that made the difference. What had taken someone four work days to get through was done in less than an hour.

Don't know if this info is of any help to you, Jackal63, but maybe so.

Heidi

 

[jackal63]

Thanks,

actually I got everything running satisfactory to the powers that be. im just waiting while the reports that were generated make the approval rounds, then after any tweaking that that entails, ill set up the functions to run automatically on file start up, clean out the generated data on exit, then ill throw the file into the guy's folder that is responsible for generating the reports and never think about it again.

Thanks to everyone for the help.