Jennifer Gross
jengross at gte.net
Fri May 30 18:46:19 CDT 2008
Hi Darryl,
Below is my procedure code. You have to have opened a PowerPoint
Presentation and an Excel Workbook. Dealing with this over many years and
many different versions of Office/Access combinations I found it easiest to
open a hidden instance of Excel, create the chart in Excel and then copy and
paste into PowerPoint. It was easier and more reliable to base the chart on
values in Excel cells than to try to populate the chart's datasheet directly
in PP. You need to makes sure you have references to PowerPoint, Excel and
MS Graph. I also wanted control over the color of the pie slices so I set
up a global ColorArray() with the numerical values for the colors I wanted.
This was important because in my application there were many charts going to
a single PP and the user always wanted the slice for say 'apples' to be the
same color in all of the charts.
This is part of creating a PP with charts interspersed between slides with
bullet points, that is why I need to know what slide we are on and I use a
new worksheet in Excel for creating each graph. Once the PP is created I
close out Excel and the user never knows that is what was used.
A lot of the formatting is client preference - so do with it what you will.
Please watch the word wrap.
Jennifer
Sub CreateChart(pptPres As PowerPoint.Presentation, pptSlideNumber As
Integer, TitleMsg As Long, _
exlwbk As Excel.Workbook, SheetNo As Integer, rsName As String,
txtFld As String, numFld As String, _
txtSortFld As String)
On Error GoTo ErrorHandler
Dim strErrMsg As String 'for Error Handling
Dim pptslide As PowerPoint.Slide
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rsSorted As DAO.Recordset
Dim ndxColumn As Integer
Dim ndxRow As Integer
Dim SliceCount As Integer
Dim exlRange As Excel.Range
Dim ch As ChartObject
Dim x As Integer
Set db = CurrentDb
Set rs = db.OpenRecordset(rsName, dbOpenDynaset)
rs.Sort = txtSortFld
Set rsSorted = rs.OpenRecordset
If Not rsSorted.EOF And Not rsSorted.BOF Then
exlwbk.Worksheets(SheetNo).Activate
ndxColumn = 1
ndxRow = 1
SliceCount = 0
rsSorted.MoveFirst
Do While Not rsSorted.EOF
If rsSorted(numFld) > 1 Then
exlwbk.Sheets(SheetNo).Cells(ndxRow, ndxColumn) =
rsSorted(txtFld)
exlwbk.Sheets(SheetNo).Cells(ndxRow, ndxColumn + 1) =
CLng(rsSorted(numFld))
ndxRow = ndxRow + 1
SliceCount = SliceCount + 1
End If
rsSorted.MoveNext
Loop
Set exlRange = exlwbk.Worksheets(SheetNo).Range("A1:B" & SliceCount)
Set ch = exlwbk.Worksheets(SheetNo).ChartObjects.Add(100, 30, 400,
250)
ch.Chart.ChartWizard Source:=exlRange, PlotBy:=xlRows,
SeriesLabels:=1
With ch.Chart
.ChartType = xl3DPie
.Legend.Position = xlLegendPositionBottom
.Legend.Font.Name = "Arial"
.Legend.Font.Size = 12
.Legend.Left = 10
.Legend.Width = 650
.Legend.Top = 420
.Legend.Height = 200
.Legend.Font.Color = ColorArray(7)
.Legend.Fill.Visible = msoFalse
.ChartArea.Border.LineStyle = xlLineStyleNone
.PlotArea.Border.LineStyle = xlLineStyleNone
.ChartArea.Width = 620
.Rotation = 90
.Elevation = 0
.Axes(xlSeriesAxis).TickLabels.Delete
.Walls.Interior.Color = rgb(255, 255, 255)
.Floor.Interior.Color = rgb(255, 255, 255)
.SeriesCollection(1).HasDataLabels = msoFalse
For x = 1 To SliceCount
.SeriesCollection(1).Points(x).Interior.Color =
ColorArray(x)
.SeriesCollection(x).Interior.Color = ColorArray(x)
.Axes(xlCategory).TickLabels.Delete
Next x
If SliceCount < 4 Then
For x = 5 To SliceCount + 2 Step -1
.DataTable.Columns(x).Delete
Next x
End If
'delete rows that are causing bars to be thin
For x = 3 To 10 Step 1
.DataTable.Rows(3).Delete
Next x
.Refresh
'.Application.Quit
ch.Select
ch.Copy
End With
Set pptslide = pptPres.Slides.Add(pptPres.Slides.Count + 1,
ppLayoutChart)
pptslide.Shapes.Title.TextFrame.TextRange.Text = TitleMsg
pptslide.Shapes(2).Delete
pptslide.Shapes.Paste
With pptslide.Shapes(2)
.Left = 25
.Top = 55
.Width = 500
.Height = 425
End With
End If
ExitHere:
DoCmd.SetWarnings True
rs.Close
rsSorted.Close
Set db = Nothing
Exit Sub
ErrorHandler:
Select Case Err
Case 91
'do nothing - object never opened
err.clear
Resume Next
Case 1004
Resume Next
Case Else
strErrMsg = "An error occurred in " & "CreateChart" & vbCrLf &
vbCrLf & vbCrLf
strErrMsg = strErrMsg & "Error #: " & Format$(Err.Number) &
vbCrLf & vbCrLf
strErrMsg = strErrMsg & "Error Description: " & Err.Description
MsgBox strErrMsg, vbInformation, "CreateChart"
Resume ExitHere
End Select
End Sub
-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Darryl Collins
Sent: Thursday, May 29, 2008 2:37 PM
To: Access Developers discussion and problem solving
Subject: Re: [AccessD] A better picture?
aaaaah, Lebans, I should have guessed. Will also have a look at this option,
although I also like the sound of Jennifer's approach.
many thanks
Darryl
-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com]On Behalf Of William Hindman
Sent: Thursday, 29 May 2008 5:30 PM
To: Access Developers discussion and problem solving
Subject: Re: [AccessD] A better picture?
http://www.lebans.com/loadsavejpeg.htm
...he uses the intel jpeg library to allow Access to use much larger jpegs
in the image control ...should in turn give you a much cleaner pdf graphic
output ...he also has a report converter to word that manages large embedded
graphics ...I use it regularly with clients rather than snapshot.
William
"The truth is incontrovertible, malice may attack it, ignorance may deride
it, but in the end; there it is."
--------------------------------------------------
From: "Darryl Collins" <Darryl.Collins at coles.com.au>
Sent: Thursday, May 29, 2008 12:45 AM
To: "Access Developers discussion and problem solving"
<accessd at databaseadvisors.com>
Subject: Re: [AccessD] A better picture?
>
>
> aaah, seems like snapshot is the only option. i have added an "Export..."
> button to the custom toolbar to allow the users to do this. If anyone
> has a better suggestion I am all ears.
>
> :)
>
>
>
> -----Original Message-----
> From: accessd-bounces at databaseadvisors.com
> [mailto:accessd-bounces at databaseadvisors.com]On Behalf Of Darryl
> Collins
> Sent: Thursday, 29 May 2008 2:26 PM
> To: Access Developers discussion and problem solving
> Subject: [AccessD] A better picture?
>
>
>
> Hi People,
>
> I have a button to create a PDF from a report. Then my ever so
> creative users are taking a copy of the PDF and putting it into power
> point. Of course by this stage (3rd generation of mushy PeeCee
> Graphic conversion) the image is softer than grandma's feather bed and
much less comfy.
>
> Is there anyway of turning the Access report immediately into a JPG
> instead of using snapshot?
>
> As usual, I know you can do this in Excel with charts and the like, '
> ---------------------------- Dim Chart1 As Chart Set mychart =
> Sheets("MySheet").ChartObjects(1).Chart
> mychart.Export Filename:="C:\CopyOfMyChart.jpg", FilterName:="jpg"
> ' ----------------------------
>
> or any part of a workbook using code such as:\ Selection.CopyPicture
> Appearance:=xlScreen, Format:=xlPicture"
>
> Is this possible to do in VBA Access?
>
> regards
> Darryl.
>
> This email and any attachments may contain privileged and confidential
> information and are intended for the named addressee only. If you have
> received this e-mail in error, please notify the sender and delete
> this e-mail immediately. Any confidentiality, privilege or copyright
> is not waived or lost because this e-mail has been sent to you in
> error. It is your responsibility to check this e-mail and any attachments
for viruses.
> No warranty is made that this material is free from computer virus or
> any other defect or error. Any loss/damage incurred by using this
> material is not the sender's responsibility. The sender's entire
> liability will be limited to resupplying the material.
>
> --
> AccessD mailing list
> AccessD at databaseadvisors.com
> http://databaseadvisors.com/mailman/listinfo/accessd
> Website: http://www.databaseadvisors.com
>
> This email and any attachments may contain privileged and confidential
> information and are intended for the named addressee only. If you have
> received this e-mail in error, please notify the sender and delete
> this e-mail immediately. Any confidentiality, privilege or copyright
> is not waived or lost because this e-mail has been sent to you in
> error. It is your responsibility to check this e-mail and any attachments
for viruses.
> No warranty is made that this material is free from computer virus or
> any other defect or error. Any loss/damage incurred by using this
> material is not the sender's responsibility. The sender's entire
> liability will be limited to resupplying the material.
>
> --
> AccessD mailing list
> AccessD at databaseadvisors.com
> http://databaseadvisors.com/mailman/listinfo/accessd
> Website: http://www.databaseadvisors.com
--
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com
This email and any attachments may contain privileged and confidential
information and are intended for the named addressee only. If you have
received this e-mail in error, please notify the sender and delete this
e-mail immediately. Any confidentiality, privilege or copyright is not
waived or lost because this e-mail has been sent to you in error. It is your
responsibility to check this e-mail and any attachments for viruses. No
warranty is made that this material is free from computer virus or any other
defect or error. Any loss/damage incurred by using this material is not the
sender's responsibility. The sender's entire liability will be limited to
resupplying the material.
--
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com