Chart Type in VBA 1

[philcon]

Hi,

I have written a data visualisation tool which lets the user, see data displayed graphically utilising a number of parameters.

I have been asked to provide a facility whereby the user can create there own report, and print out a number of the paramatised graphs at once.

What I was thinking of doing was setting up an array which stored the graph sql, and then develop some code which uses the array to print of the report.

However, there are different types of chart used in the system, so I thought I would have to store some indicator of chart type within the array (don't want to print out a bar chart instead of a pie etc). The problem is I don't seem to be able to find the chart property which describes what type of chart it is.

Hopefully this isnt a no-brainer, but would appreciate all suggestions.

Many thanks



Phil.

 

[pdldavis]

Hi, try this.

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vbagr10/html/grproChartType.asp

hth.

 

[philcon]

Many thanks for the steer

KR

Phil.

 

[philcon]

Unfortunately this thread didn't help. When I try to store the charttype in an array, the value of the array element remains null.

Any further thoughts would be greatly appreciated.

 

[pdldavis]

Hi, I'm not really familiar with the definition of arrays and elements, but the following works for defining the chart type and a few other things using the Updated event in an Access Form. Perhaps this will be helpful:

Private Sub GraphToDts_Updated(Code As Integer)
Dim Systems
Systems = DCount("[SuSys]", "tblSus") 'Get Number of Packages
Me![GraphToDts].ChartType = xlXyScatterSmooth 'Define Chart Type
Me![GraphToDts].Axes(xlValue, xlSecondary).MaximumScale = Systems
Me![GraphToDts].Axes(xlValue, xlSecondary).MinimumScale = 0
With Me!GraphToDts.ChartTitle
.Caption = DLookup("[Jobname]", "tblJobs", "[number]=1") & " Turnover Package Completion"
End With
With Me!GraphToDts.Axes(xlValue, xlSecondary)
.HasTitle = True
.AxisTitle.Text = Systems & " Startup Packages" ' add Y-Axis Label
End With
End Sub

 

[philcon]

Thanks for the tip pdldavis, though I'm not having much fun getting it to work, what version of Access are you using?

I am using 2002, and if I try to use the line of code:

me.chart0.ChartType = xlbarclustered


I get a type mismatch error. I had seem someone else using :

me.chart0.xlChartType = xlbarclustered

However when I try that I get

"Object doesn't support this property or method"


Hold the press,

can now get the following to work in a form :

Me.CHART0.charttype = gs_reptab(gs_repno, 3)
' where the array element = 57 (the xl ref number for a clustered bar chart)
Me.CHART0.RowSource = gs_reptab(gs_repno, 1)
Me.SUBTIT = gs_reptab(gs_repno, 2)

However, I get the "Object doesn't support this ....." message when I put the exact same code in a report.

Do reports not accept dynamic chart properties ? Anyone?

Kind regards & thanks so far


Phil

 

[pdldavis]

Hi, for some reason I missed notification. I was looking for graph stuff myself (my least favorite of things to do)when I saw this.

The chart object appears to be static in a report. I don't know that there is away around this. I thought maybe you could replace the chart object when the report is opened and posted a question about that but haven't got a response.

Since I need to change the chart object properties I ended up designing a form that looks like a report and printing the form. You can set the various controls on the form do display on screen only and it looks pretty good.

The chart type question:

Some chart types will support setting the X-Axis for example, and some will not. If you have code that includes items for a graph that the graph itself doesn't support then you will get an error. I learned this the hard way.

One that works well for me is the Scatter Chart. You can set any number of items with it.

Apologies for using the xlbarclustered, I just picked one.
XlPie(Syntax?) would have worked.

Hope that helps.

 

[philcon]

Thanks once again pdldavis.

It didn't occur to me that the error was related to the particular charttype that I'd used, doh.

I left this alone for a week, and now have to gety back on it, so the other thing I was thinking of doing (yesterday actually) was creating three reports (each one containing a different charttype), and selecting whch report to open based on the charttype value in the array.

Not neat and tidy I know but, what can you do?

Thanks very much though for the responses, I reeally would have got nowhere by now without them.

Phil.

 

[pdldavis]

No problem. If you ever come up with a solution for updating the chart object in a report, I would be most interested. I don't need to change chart types but I do need to change the axis values depending on the job.

Those charts in theory are supposed to be emailed.
That's easy to do with a report but since each job uses the same front end, all jobs end up with the same xy settings for the report - which prompted more than a few phone calls.

It would be nice to see a solution for this. I tried utter access and will give experts exchange a try too if it's still free.

 

[philcon]

DONE IT!!!!!!!

If you open up the report in edit mode you can make the changes discussed. As mentioned I am using an array to store the different elements but you can still get the gist (apologies for appalling code - not finished yet)

for ctr = 1 to x
DoCmd.OpenReport "testrep", acViewDesign
Reports!testrep!CHART0.charttype = gs_reptab(gs_repno, 3)
MySQL = gs_reptab(gs_repno, 1)
Reports!testrep!CHART0.RowSource = MySQL
Reports!testrep!TITLE.Caption = gs_reptab(gs_repno, 2)
Reports!testrep!SUBTIT.Caption = gs_reptab(gs_repno, 4)
DoCmd.OpenReport "testrep", acViewNormal
DoCmd.Close acReport, "testrep", acSaveYes
gs_repno = gs_repno + 1
Next ctr

you have to remember to close the report otherwise it hangs around in design view after it has been printed out.

 

[pdldavis]

Well I'll be..... Have a star and a bunch of Brownie Points!

It's been a good six months wrestling with this one.

This is what I came up with so far & its finally working.


Dim stDocName As String

Dim Systems

Systems = DCount("[SuSys]", "tblSus") 'Get Number of Packages

stDocName = "rptToPkCompletion"

DoCmd.OpenReport stDocName, acDesign

Reports!rptToPkCompletion.GraphToDts.Axes(xlValue, xlSecondary).MaximumScale = Systems
Reports!rptToPkCompletion.GraphToDts.Axes(xlValue, xlSecondary).MinimumScale = 0


With Reports!rptToPkCompletion.GraphToDts.ChartTitle
.Caption = DLookup("[Jobname]", "tblJobs", "[number]=1") & " Turnover Package Completion"
End With
With Reports!rptToPkCompletion.GraphToDts.Axes(xlValue, xlSecondary)
.HasTitle = True
.AxisTitle.Text = Systems & " Startup Packages" ' add Y-Axis Label
End With


DoCmd.Close acReport, stDocName, acSaveYes

DoCmd.OpenReport stDocName, acPreview

 

[pdldavis]

PhilCon, Well, I got this finished. I thought I would post the whole thing. The intent is to send out an automated email on Mondays with 2 reports and 2 *$*&!
graphs attached as snapshots to a primary and CC'd recipients. I think I still have some unnecessary stuff in here but it works fine.

The original email code was from another post and modified for this purpose. Added some html formatting and some other stuff too.

Someone else might find some of this useful.


Private Sub Form_Load()
On Error GoTo Err_EmailError

Dim response
Dim exitapp

'This is to check to see if the day is a Monday and checks to see if the email has been sent.

Me.txtTodayDate = WeekdayName(Weekday(Date))

If Me.txtTodayDate = DLookup("[sendDate]", "tblEmailSendDate", "[id]=1") Then

DoCmd.Close acForm, "frmEmailRpts", acSaveNo
End If


'See if the item has been sent
Select Case Me.txtTodaysDate

Case Is = DLookup("[sendDate]", "tblEmailSendDate", "[id]=1")
DoCmd.Close acForm, "frmEmailRpts", acSaveNo

'If not sent - Send the files
Case Is > DLookup("[sendDate]", "tblEmailSendDate", "[id]=1")

If Me.txtTodayDate <> "Monday" Then

GoTo exitapp

End If


'See if Date is Monday
If Me.txtTodayDate = "Monday" Then


response = MsgBox("It's Monday and time to send out the weekly reports." & _
Chr(13) & Chr(13) & _
"Is your default printer capable of printing 11x17 reports?", vbYesNo, "Default Printer Check")

End If


If response = vbNo Then

MsgBox "Set the correct default printer for 11x17", vbInformation, "Change Printer Settings"

DoCmd.Quit acQuitSaveNone

End If

If response = vbYes Then


MsgBox "Thank You, Continuing with Report Generation", vbOKOnly

End If

Dim myDir
Dim myfile

myDir = Dir("C:\Snapshots", vbDirectory) 'Check to see if directory exists

If myDir = "" Then
'Need to create Directory
MkDir ("C:\Snapshots")
End If

'If Directory is Full, Empty Directory
If Dir("c:\Snapshots\*.*") > vbNullString Then
Kill ("c:\Snapshots\*.*")
End If

'Output reports to Snapshot Format
DoCmd.SetWarnings False


'/////////////////////////////////////////////////////////////////////////////////////////'

'This should fix the turnover Completion Graph - 08-16-04'


Dim StDocName As String

Dim Systems
Dim MileStones
Dim Package

Systems = DCount("[SuSys]", "tblSus") 'Get Number of Packages
MileStones = DCount("[SuSys]", "tblSus", "left([SuSys],1)='*'") 'Get Number of Milestones


Package = Systems - MileStones 'Real Packages

StDocName = "rptToPkCompletion"

DoCmd.OpenReport StDocName, acDesign

Reports!rptToPkCompletion.GraphToDts.Axes(xlValue, xlSecondary).MaximumScale = Package
Reports!rptToPkCompletion.GraphToDts.Axes(xlValue, xlSecondary).MinimumScale = 0


With Reports!rptToPkCompletion.GraphToDts.ChartTitle
.Caption = DLookup("[Jobname]", "tblJobs", "[number]=1") & " Turnover Package Completion"
End With
With Reports!rptToPkCompletion.GraphToDts.Axes(xlValue, xlSecondary)
.HasTitle = True
.AxisTitle.Text = Package & " Startup Packages" ' add Y-Axis Label
End With


DoCmd.Close acReport, StDocName, acSaveYes

'///////////////////////////////////////////////////////////////////////////////////////////'

'This should fix the Earned Completion Graph 08-16-04
Dim sys
Dim DdDate
Dim StDate
Dim X

X = DSum("[mhrs Budget]", "Ad-AddSpecialsBudget", "[mhrs budget]")

DdDate = DLookup("[CodDate]", "[tblCodDate]", "[ID]=1") 'Get Drop Dead Date
StDate = DMin("[ActToDt]", "tblStatus")
sys = DCount("[SuSys]", "tblSus") 'Get Number of Packages


DoCmd.OpenReport "rptToPkEarnedCompletion", acDesign

Reports!rptToPkEarnedCompletion.[GraphToDts].Axes(xlCategory).MinimumScale = StDate
Reports!rptToPkEarnedCompletion.[GraphToDts].Axes(xlCategory).MaximumScale = DdDate 'Set Drop Dead Date as Max for Graph
Reports!rptToPkEarnedCompletion.[GraphToDts].Axes(xlValue, xlPrimary).MinimumScale = SchTODt
Reports!rptToPkEarnedCompletion.[GraphToDts].Axes(xlValue, xlPrimary).MaximumScale = X

With Reports!rptToPkEarnedCompletion
Reports!rptToPkEarnedCompletion.GraphToDts.ChartTitle.Caption = DLookup("[Jobname]", "tblJobs", "[number]=1") & " Earned Man-Hours"
End With

With Reports!rptToPkEarnedCompletion.[GraphToDts].Axes(xlValue, xlPrimary)
.HasTitle = True
.AxisTitle.Text = "Total Budgeted Man-Hours: " & X
End With

DoCmd.Close acReport, "rptToPkEarnedCompletion", acSaveYes


'////////////////////////////////////////////////////////////////////////////////////////////////'

'Create Snapshots

DoCmd.OutputTo acOutputReport, "rptTurnoverMt", acFormatSNP, "C:\Snapshots\Commissioning Status Report.snp"
DoCmd.OutputTo acOutputReport, "rptSystemTurnover", acFormatSNP, "C:\Snapshots\System Turnover Report Report.snp"
DoCmd.OutputTo acOutputReport, "rptToPkCompletion", acFormatSNP, "C:\Snapshots\Turnover Package Completion Graph.snp"
DoCmd.OutputTo acOutputReport, "rptToPkEarnedCompletion", acFormatSNP, "C:\Snapshots\Turnover Package Earned Completion Graph.snp"

DoCmd.SetWarnings True


'Get Persons Cc'd
Dim StEql As String
StEql = "SELECT tblEmails.[E-Mail], tblEmails.CcFlag From tblEmails " & _
"WHERE tblEmails.CcFlag= -1;"

'Dim rst As Recordset
Dim StSql As String
Dim CcPers As String

Set rst = CurrentDb.OpenRecordset(StEql, dbOpenDynaset)
rst.MoveFirst
Do Until rst.EOF
CcPers = CcPers & rst.[E-Mail] & "; "
rst.MoveNext
Loop

'Go on with rest of Email

Dim db As DAO.Database
Dim MailList As DAO.Recordset
Dim MyOutlook As Outlook.Application
Dim MyMail As Outlook.MailItem
Dim Subjectline As String
Dim BodyFile As String
Dim Attachment1 As String
Dim Attachment2 As String
Dim fso As FileSystemObject
Dim MyBody As TextStream
Dim myBodyText As String
Dim MyJob As String
Dim MyPrimaryAddress As String
Dim Vlv As Integer 'Total Valves
Dim VlvComp As Integer 'Valves Complete
Dim VlvPct As Double 'Valve Percentage
Dim Inst As Integer 'Total Instruments
Dim InstComp As Integer 'Instruments Complete
Dim InstPct As Double 'Instrument Percentage
Dim Eq As Integer 'Total Equipment
Dim EqComp As Integer 'Equipment Complete
Dim EqPct As Double 'Equipment Percentage
Dim Flush As Integer 'Total Flushes
Dim FlushComp As Integer 'Flushes Complete
Dim FlushPct As Double 'Flush Percentage
Dim Func As Integer 'Total Functions
Dim FuncComp As Integer 'Functions Complete
Dim FuncPct As Double 'Function Percentage
Dim Spec As Integer 'Total Specialties
Dim SpecComp As Integer 'Specialties Complete
Dim SpecPct As Double 'Specialy Percentage

Vlv = DCount("*", "tblValveList", "[ValveID]") 'Total Valves
VlvComp = DCount("*", "tblValveList", "[SuManVChkCpl] = -1") 'Valves Complete
VlvPct = FormatNumber(VlvComp / Vlv, 3) * 100 'Valve Percentage

Inst = DCount("*", "tblInstIndexSU", "[instTagNumber]") 'Total Instruments
InstComp = DCount("*", "tblInstIndexSU", "[InstComplete] = -1") 'Instruments Complete
InstPct = FormatNumber(InstComp / Inst, 3) * 100 'Instrument Percentage

Eq = DCount("*", "tblEqList", "[tagNo]") 'Total Equipment
EqComp = DCount("*", "tblEqList", "[InspecComplete] = -1") 'Equipment Complete
EqPct = FormatNumber(EqComp / Eq, 3) * 100 'Equipment Percentage


Flush = DCount("*", "tblFlushes", "[FlushID]") 'Total Flushes
FlushComp = DCount("*", "tblFlushes", "[FlushComplete] = -1") 'Flushes Complete
FlushPct = FormatNumber(FlushComp / Flush, 3) * 100 'Flush Percentage

Func = DCount("*", "tblFunctional", "[FunctionalID]") 'Total Functionals
FuncComp = DCount("*", "tblFunctional", "[Complete] = -1") 'Functionals Complete
FuncPct = FormatNumber(FuncComp / Func, 3) * 100 'Functional Percentage

Spec = DCount("*", "tblSpecialties", "[SoloDataLink]") 'Total Specialties
SpecComp = DCount("*", "tblSpecialties", "[InspecComplete] = -1") 'Specialties Complete
SpecPct = FormatNumber(SpecComp / Spec, 3) * 100 'Specialty Percentage

Set fso = New FileSystemObject

'Job Name
MyJob = DLookup("[jobname]", "tblJobs", "[number] = 1")

'Person Sent Email

MyPrimaryAddress = DLookup("[E-Mail]", "tblEmails", "[Email FLag] = -1")

'Subject - Commissioning Report
Subjectline = "Commissioning Status Reports for " & MyJob


BodyFile$ = "Commissioning Status Reports for " & txtTodaysDate & "."
myBodyText = "<Center><B>Automated Email sent from " & MyJob & "</B></Center><br><br>" & _
"<B>Completion Summary:</B><br><br>" & _
"There are <b>" & Vlv & " </b> total valves. <b> " & VlvComp & " </b> are indicated as complete. This is about <b>" & VlvPct & "%.</b><br><br>" & _
"There are <b>" & Inst & " </b> total instruments.<b> " & InstComp & " </b> are indicated as complete. This is about <b>" & InstPct & "%.</b><br><br>" & _
"There are <b>" & Eq & " </b> total pieces of equipment.<b> " & EqComp & " </b> are indicated as complete. This is about <b>" & EqPct & "%.</b><br><br>" & _
"There are <b>" & Flush & " </b> total flushes. <b>" & FlushComp & " </b> are indicated as complete. This is about <b>" & FlushPct & "%.</b><br><br>" & _
"There are <b>" & Func & " </b> total functionals.<b> " & FuncComp & " </b> are indicated as complete. This is about <b>" & FuncPct & "%.</b><br><br>" & _
"There are <b>" & Spec & " </b> total specialties. <b>" & SpecComp & " </b> are indicated as complete. This is about <b>" & SpecPct & "%.</b>"


'Attachments
Attachment1 = "C:\Snapshots\Commissioning Status Report.snp"
Attachment2 = "C:\Snapshots\System Turnover Report Report.snp"
Attachment3 = "C:\Snapshots\Turnover Package Completion Graph.snp"
Attachment4 = "C:\Snapshots\Turnover Package Earned Completion Graph.snp"

' Open Outlook
Set MyOutlook = New Outlook.Application

' Set up the database and query connections

Set db = CurrentDb()
Set MailList = db.OpenRecordset("tblEMails")


' Creates the e-mail

Set MyMail = MyOutlook.CreateItem(olMailItem)

' This addresses it

MyMail.To = MyPrimaryAddress
MyMail.CC = CcPers


'This gives it a subject

MyMail.Subject = Subjectline$

'This gives it the body. HTMLBody allows the for the use of HTML tabs in the message body.

MyMail.HTMLBody = myBodyText

'This gives it the attachment

MyMail.Attachments.Add Attachment1
MyMail.Attachments.Add Attachment2
MyMail.Attachments.Add Attachment3
MyMail.Attachments.Add Attachment4

'This sends it!

MsgBox "Sending out Weekly Reports." & vbCrLf & vbLf & _
"Please Select OK when Prompted by Outlook." & vbCrLf & vbLf & _
"If Randall Does Not Recieve Reports from Your Site Today," & vbCrLf & vbLf & _
"Please be Prepared to Explain Why Not", vbExclamation, "Helpful Message"

MyMail.Send

'Cleanup

Set MyMail = Nothing

'Uncomment the next line if you want Outlook to shut down when its done.
'Otherwise, it will stay running.

'MyOutlook.Quit
Set MyOutlook = Nothing

MailList.Close
Set MailList = Nothing
db.Close
Set db = Nothing
DoCmd.SetWarnings True

'Update the Send Date so Email Doesn't get Sent Twice

DoCmd.SetWarnings False

DoCmd.RunSQL "UPDATE tblEmailSendDate SET tblEmailSendDate.SendDate = [Forms]![frmEmailRpts]![txtTodaysDate]" & _
"WHERE (((tblEmailSendDate.ID)=1)); "
DoCmd.SetWarnings True

Case Else:
DoCmd.Close acForm, "frmEmailRpts", acSaveNo
End Select


exitapp:
DoCmd.Close acForm, "frmEmailRpts", acSaveNo


Exit_EmailError:
Exit Sub

Err_EmailError:

MsgBox "There was a problem sending the weekly reports. Please try Again", vbInformation, "Error Message"
Resume Exit_EmailError


End Sub

 

[BruceThomas]

You can use VBA to modify charts at run-time in Access (97+)reports. You must put the code in the Format or Print Event of the section that contains the graph.
Here is code that I successfully use to dynamically change the maximum scale setting of the Y-Axis in an Access 2k application. The chart called SvChart is in the Detail section of my report.

Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
Dim objGraph As Object
Const conProc = "Detail_Format"
On Error GoTo Err_Handler

Set objGraph = Me!SvChart.Object
If mintMaxScale > 0 Then
objGraph.Application.Chart.Axes(2).MaximumScaleIsAuto = False
objGraph.Application.Chart.Axes(2).MaximumScale = mintMaxScale
End If
objGraph.Refresh
DoEvents
'Debug.print objGraph.Application.Chart.Axes(2).MaximumScale
'Debug.print objGraph.Application.Chart.Axes(2).MaximumScaleIsAuto

Exit_Point:
Set objGraph = Nothing
Exit Sub

Err_Handler:
Select Case Err.Number
Case Else
MsgBox "Error #" & Err.Number & " - " & Err.Description, _
vbExclamation, "Error in " & conProc
End Select
Resume Exit_Point

End Sub

 

[pdldavis]

Thanks Bruce for the information. I'll give it a try. Any help regarding graphs / reports is appreciated by me.

Thanks