[AccessD] A better picture?

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





More information about the AccessD mailing list