Create Charts...

How to use report recordsource to plot a chart.  The data will be in detail section; and the same data need to be presented using a pie or bar chart as well.

LVL 34
Mike EghtebasDatabase and Application DeveloperAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Sayad Aziz AhmadCommented:
u can place chart on report from Menubar Insert ----> Chart

in row source of the chart u can use ur query to derive the data


Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Jim HornSQL Server Data DudeCommented:
The one time I pulled this off, I was not able to assign a .RecordSource = Some SQL to a Chart object on a report, like you would a report's .RecordSource.  

Below is a code dump of how I had to use VBA to open a report and assign a ton of stuff to it's various properties using an ADODB recordset, close the report, then open it.  If you need any deciphering help, let me know.  Good luck.  -Jim

Public Sub sb_chart_load_or_export(lChartID As Long, Optional ByRef frm As Object, Optional bReport As Boolean)

'Populate this chart with the SQL, and form controls with chart values.
'This is the ONLY funciton that loads the chart with all its values from tbl_charts.
'(There are local events in fsub_indicators_charts that will modify one property.)

'frm can = a FORM or a REPORT.
'frm.Chart1     The Excel.Chart.8, a.k.a. 'Microsoft Excel 97 Chart' object
'frm        The form that other controls are populated with. (fsub_indicators_charts only)
'lChartID   The ID of the chart. (fsub_indicators_charts.sb_chart_load_or_export only)
'           0=New.

'This function is used three different ways:

'Load an existing chart in fsub_indicators_charts
'Load a new chart in fsub_indicators_charts
'Export an existing chart to PowerPoint.

On Error GoTo error_handler

Call sb_cn

Dim rsDates As ADODB.Recordset
Set rsDates = New ADODB.Recordset

Dim oChart As Graph.Chart
If bReport Then
    Dim rpt As Access.Report
    DoCmd.OpenReport "rpt_charts", acViewDesign, , , acHidden
    Set rpt = Reports("rpt_charts")
    Set oChart = rpt.chart1.Object
    Set oChart = frm.chart1.Object
End If

Dim sSQL As String, lMonthFirst As Long, lMonthLast As Long
Dim bForm As Boolean, bChartNew As Boolean

'Was a form passed?  (This function will also refresh form controls as well as the graph.)
If frm Is Nothing Then
    bForm = False
    bForm = True
    'Clear out the existing chart data and formatting
End If

'Was a Chart ID passed?  (If not, then this is a new chart.)
If lChartID = 0 Then
    bChartNew = False
    bChartNew = True
End If

'Validate that the rsChart object exists
If rsChart Is Nothing Then
    Set rsChart = New ADODB.Recordset
    rsChart.CursorLocation = adUseClient
    rsChart.CursorType = adOpenDynamic
    rsChart.LockType = adLockBatchOptimistic
End If

'Grab/create the one tbl_charts record for this lChartID.
'If bChartNew Then
If rsChart.State <> adStateClosed Then rsChart.Close
rsChart.CursorLocation = adUseClient
rsChart.Open "SELECT * FROM tbl_charts WHERE lng_ID = " & lChartID, cn, adOpenDynamic, adLockBatchOptimistic

If Not (rsChart.BOF And rsChart.EOF) Then
    'Chart and Indicator ID's
    If bForm Then
        frm.lng_id.Value = rsChart!lng_id
        frm.lng_indicator_id.Value = rsChart!lng_indicator_id
    End If
    'Chart data
    If Not IsNull(rsChart!mmo_chart_sql.Value) Then
        If bForm Then
            frm.chart1.RowSourceType = "Table/Query"
            frm.chart1.RowSource = rsChart!mmo_chart_sql.Value
        End If
        'There is no SQL statement for this chart.  Should never happen.
        If bForm Then
            frm.chart1.RowSourceType = ""
            frm.chart1.RowSource = ""
        End If
    End If
    'Get the earliest month of data for this indicator (Prep for date ranges)
    sSQL = "SELECT Min(lng_month_id) AS [value] "
    sSQL = sSQL & "FROM tbl_indicators_data "
    sSQL = sSQL & "WHERE (lng_indicator_id = " & rsChart!lng_indicator_id & ");"
    rsDates.Open sSQL, cn, adOpenStatic, adLockReadOnly
    If Not IsNull(rsDates!Value) Then
        lMonthFirst = rsDates!Value
        'There is no data for this indicator, bail.
        GoTo exit_function
    End If
    'Get the latest month of data for this indicator
    If rsDates.State <> adStateClosed Then rsDates.Close
    sSQL = "SELECT Max(lng_month_id) AS [value] "
    sSQL = sSQL & "FROM tbl_indicators_data "
    sSQL = sSQL & "WHERE (lng_indicator_id = " & rsChart!lng_indicator_id & ");"
    rsDates.Open sSQL, cn, adOpenStatic, adLockReadOnly
    lMonthLast = rsDates!Value
    'Set the month combo boxes the the range of dates in the data
    sSQL = "SELECT tbl_indicators_data.lng_month_id, tbl_time.txt_time_month_year "
    sSQL = sSQL & "FROM tbl_time INNER JOIN tbl_indicators_data ON tbl_time.lng_id = tbl_indicators_data.lng_month_id "
    sSQL = sSQL & "WHERE (lng_indicator_id = " & rsChart!lng_indicator_id & ") "
    sSQL = sSQL & "ORDER BY tbl_indicators_data.lng_month_id "
    If bForm Then
        With frm
            .cbo_time_series_from.RowSource = sSQL
            .cbo_time_series_to.RowSource = sSQL
            If rsChart!bln_chart_date_range_lock = True Then
                'Dates are locked, grab the lng_chart_from and lng_chart_to values.
                .chk_chart_date_range_lock.Value = True
                .cbo_time_series_from.Value = rsChart!lng_chart_from
                .cbo_time_series_to.Value = rsChart!lng_chart_to
                'Dates are not locked, grab the entire recordset. (Do not validate/edit data during load.)
                .chk_chart_date_range_lock = False
                .cbo_time_series_from.Value = lMonthFirst
                .cbo_time_series_to.Value = lMonthLast
            End If
        End With
    End If
    'Set the Values combo box.
    If bForm Then
        Dim lCount As Long, x As Long
        Dim rsValues As ADODB.Recordset
        lCount = frm.cbo_indicator_values.ListCount
        For x = lCount To 1 Step -1
            frm.cbo_indicator_values.RemoveItem (x - 1)
        Set rsValues = fn_parameter_query("qcbo_indicators_values", "lng_value_id", frm.lng_indicator_id)
        If Not (rsValues.BOF And rsValues.EOF) Then
            For x = 0 To rsValues!byt_ind_values_number
                'Add all indicators
                If x = 0 Then
                    frm.cbo_indicator_values.AddItem "0;<< Multiple >>"
                    If Len(rsValues("txt_idata_name_" & x)) > 0 Then
                        frm.cbo_indicator_values.AddItem x & ";" & rsValues("txt_idata_name_" & x)
                        Exit For
                    End If
                End If
            Select Case Len(Nz(rsChart!txt_indicator_values_ids, ""))
                Case 0
                    'No indicator value.  Just slam the default in here.
                    frm.cbo_indicator_values.Value = rsValues!byt_ind_values_default
                Case 1
                    'One indicator value.
                    frm.cbo_indicator_values.Value = rsChart!txt_indicator_values_ids
                Case Is > 1
                    'Multiple indicators (Only displayed in fdlg_indicators_values)
                    frm.cbo_indicator_values.Value = 0
            End Select
        End If
        Set rsValues = Nothing
    End If

    'Chart Type
    Select Case rsChart!int_chart_type
        Case 57, 58, 4, -4101, 76, 78, 51, 4100, 5, 4102
            'Bar, Stacked Bar, Line, 3dLine, Area, 3dArea, Column, 3dColumn, Pie, 3dPie
            oChart.ChartType = rsChart!int_chart_type
            If bForm Then frm.opg_graph_type.Value = rsChart!int_chart_type
        Case Else
            'Graph type stored in tbl_charts is not a type with a button on the form.
    End Select

    'Chart title and formatting (below line returns errmsg 1004 'Unable to set ...", no idea why.

    With oChart
        .HasTitle = True
        .ChartTitle.Caption = rsChart!txt_chart_name.Value
    End With
    If bForm Then frm!cbo_chart_name.Value = lChartID
    With oChart.ChartTitle.Font
        .Name = rsChart!txt_chart_title_font_name
        .Color = rsChart!lng_chart_title_color
        .Size = rsChart!int_chart_title_height
        .Italic = rsChart!bln_chart_title_italic
        .Bold = rsChart!bln_chart_title_bold
        .UnderLine = rsChart!bln_chart_title_underline
    End With
    'Chart legend
    oChart.HasLegend = rsChart!bln_chart_has_legend
    If bForm Then frm.tgl_legend.Value = rsChart!bln_chart_has_legend
    'Data table
    oChart.HasDataTable = rsChart!bln_chart_has_data_table
    If bForm Then frm.tgl_data_table.Value = rsChart!bln_chart_has_data_table
    'Sort order
    If InStr(UCase(rsChart!mmo_chart_sql.Value), "ASC;") > 0 Then
        If bForm Then frm.cbo_sort_order.Value = "Ascending"
    ElseIf InStr(UCase(rsChart!mmo_chart_sql.Value), "DESC;") > 0 Then
        If bForm Then frm.cbo_sort_order.Value = "Descending"
        If bForm Then frm.cbo_sort_order.Value = "None"
    End If

    'X Axis: Major gridlines, minor gridlines
    If rsChart!bln_x_axis_major_gridlines Then
        oChart.Axes(xlPrimary).HasMajorGridlines = True
        oChart.Axes(xlPrimary).HasMajorGridlines = False
    End If
    If bForm Then frm.chk_x_axis_major_gridlines.Value = rsChart!bln_x_axis_major_gridlines

    If rsChart!bln_x_axis_minor_gridlines Then
        oChart.Axes(xlPrimary).HasMinorGridlines = True
        oChart.Axes(xlPrimary).HasMinorGridlines = False
    End If
    If bForm Then frm.chk_x_axis_minor_gridlines.Value = rsChart!bln_x_axis_minor_gridlines

    'X Axis Title
    If rsChart!bln_x_axis_title_exists Then
        oChart.Axes(xlPrimary).HasTitle = True
        If Not IsNull(rsChart!txt_x_axis_title) And rsChart!txt_x_axis_title <> "" Then
            oChart.Axes(xlPrimary).AxisTitle.Text = CStr(rsChart!txt_x_axis_title)
            If Not IsNull(rsChart!lng_x_axis_title_orientation) Then oChart.Axes(xlPrimary).AxisTitle.Orientation = CLng(rsChart!lng_x_axis_title_orientation)
        End If
        oChart.Axes(xlPrimary).HasTitle = False
    End If
    If bForm Then
        frm.chk_x_axis_title_exists.Value = CVar(rsChart!bln_x_axis_title_exists)
        frm.txt_x_axis_title = rsChart!txt_x_axis_title
        frm.txt_x_axis_title.Visible = rsChart!bln_x_axis_title_exists
        frm.cbo_x_axis_title_orientation.Value = CLng(Nz(rsChart!lng_x_axis_title_orientation, 0))
    End If
    'X Axis Labels Orientation
    If Not IsNull(rsChart!lng_x_axis_label_orientation) Then
        oChart.Axes(xlPrimary).TickLabels.Orientation = rsChart!lng_x_axis_label_orientation
        If bForm Then
            frm.cbo_x_axis_label_orientation.Value = rsChart!lng_x_axis_label_orientation
        End If
    End If
    'X Axis Labels Number Format ('October 2002' vs. 'Oct-02')
    If Not IsNull(rsChart!txt_x_axis_number_format) Then
        oChart.Axes(xlPrimary).TickLabels.NumberFormat = rsChart!txt_x_axis_number_format
        If bForm Then
            frm.cbo_x_axis_number_format.Value = rsChart!txt_x_axis_number_format
        End If
    End If

    'Y Axis: Major gridlines, minor gridlines
    If rsChart!bln_y_axis_major_gridlines Then
        oChart.Axes(xlSecondary).HasMajorGridlines = True
        oChart.Axes(xlSecondary).HasMajorGridlines = False
    End If
    If bForm Then frm.chk_y_axis_major_gridlines.Value = rsChart!bln_y_axis_major_gridlines

    If rsChart!bln_y_axis_minor_gridlines Then
        oChart.Axes(xlSecondary).HasMinorGridlines = True
        oChart.Axes(xlSecondary).HasMinorGridlines = False
    End If
    If bForm Then frm.chk_y_axis_minor_gridlines.Value = rsChart!bln_y_axis_minor_gridlines

    'Y Axis Title
    If rsChart!bln_y_axis_title_exists Then
        oChart.Axes(xlSecondary).HasTitle = True
        If Not IsNull(rsChart!txt_y_axis_title) And rsChart!txt_y_axis_title <> "" Then
            oChart.Axes(xlSecondary).AxisTitle.Text = CStr(rsChart!txt_y_axis_title)
            If Not IsNull(rsChart!lng_y_axis_title_orientation) Then oChart.Axes(xlSecondary).AxisTitle.Orientation = CLng(rsChart!lng_y_axis_title_orientation)
        End If
        oChart.Axes(xlSecondary).HasTitle = False
    End If
    If bForm Then
        frm.chk_y_axis_title_exists.Value = CVar(rsChart!bln_y_axis_title_exists)
        frm.txt_y_axis_title = rsChart!txt_y_axis_title
        frm.txt_y_axis_title.Visible = rsChart!bln_y_axis_title_exists
        frm.cbo_y_axis_title_orientation = rsChart!lng_y_axis_title_orientation
    End If
    'Y Axis: Scale Minimum and Maximum, Major Units, Minor Units
    With oChart.Axes(2)
        If Not IsNull(rsChart!dbl_y_axis_scale_min) Then
            .minimumscale = rsChart!dbl_y_axis_scale_min
            If bForm Then frm.txt_y_axis_scale_min = rsChart!dbl_y_axis_scale_min
            .MinimumScaleIsAuto = True
            If bForm Then frm.txt_y_axis_scale_min = Null
        End If
        If Not IsNull(rsChart!dbl_y_axis_scale_max) Then
            .maximumscale = rsChart!dbl_y_axis_scale_max
            If bForm Then frm.txt_y_axis_scale_max = rsChart!dbl_y_axis_scale_max
            .MaximumScaleIsAuto = True
            If bForm Then frm.txt_y_axis_scale_max = Null
        End If
        If Not IsNull(rsChart!dbl_y_axis_unit_minor) Then
            .minorunit = rsChart!dbl_y_axis_unit_minor
            If bForm Then frm.txt_y_axis_unit_minor = rsChart!dbl_y_axis_unit_minor
            .MinorUnitIsAuto = True
            If bForm Then frm.txt_y_axis_unit_minor = Null
        End If
        If Not IsNull(rsChart!dbl_y_axis_unit_major) Then
            .majorunit = rsChart!dbl_y_axis_unit_major
            If bForm Then frm.txt_y_axis_unit_major = rsChart!dbl_y_axis_unit_major
            .MajorUnitIsAuto = True
            If bForm Then frm.txt_y_axis_unit_major = Null
        End If
    End With
    'Data Labels
    If Not bReport Then
        Select Case rsChart!byt_chart_data_labels
            Case 0, Null
                frm.chart1.SeriesCollection(1).ApplyDataLabels xlDataLabelsShowNone, True
            Case 1
                frm.chart1.SeriesCollection(1).ApplyDataLabels xlDataLabelsShowValue, True
            Case 2
                frm.chart1.SeriesCollection(1).ApplyDataLabels xlDataLabelsShowLabel, True
        End Select
        If bForm Then frm.cbo_data_labels.Value = Nz(rsChart!byt_chart_data_labels, 0)
    End If
    Select Case rsChart!bln_chart_trendline
        Case -1, True
            If oChart.SeriesCollection(1).Trendlines.Count = 0 Then
                oChart.SeriesCollection(1).Trendlines(1).Type = 3
                'Already there.  Do nothing.
            End If
            If bForm Then frm.cbo_chart_trendline.Value = -1
        Case Else
            If oChart.SeriesCollection(1).Trendlines.Count = 0 Then
                'Already not there.  Do nothing.
            End If
            If bForm Then frm.cbo_chart_trendline.Value = 0
            rsChart!bln_chart_trendline = 0
    End Select
    'View combo box: Determine if this graph is for anything other than 'Nominal Only'
    Select Case True
        Case InStr(1, rsChart!mmo_chart_sql, "sng_idata_roc_month_before") > 0
            'Rate of change from previous month.
            If bForm Then frm.cbo_data_view.Value = 1
        Case InStr(1, rsChart!mmo_chart_sql, "sng_idata_mavg_3mo") > 0
            '3 Month moving average.
            If bForm Then frm.cbo_data_view.Value = 2
        Case InStr(1, rsChart!mmo_chart_sql, "sng_idata_mavg_12mo") > 0
            '12 month moving average
            If bForm Then frm.cbo_data_view.Value = 3
        Case InStr(1, rsChart!mmo_chart_sql, "sng_idata_roc_3mo_12mo") > 0
            If bForm Then frm.cbo_data_view.Value = 4
        Case InStr(1, rsChart!mmo_chart_sql, "sng_idata_roc_12mo_12mo") > 0
            If bForm Then frm.cbo_data_view.Value = 5
        Case Else
            'Nominal values only
            If bForm Then frm.cbo_data_view.Value = 0
    End Select
End If

If bReport Then
    DoCmd.Close acReport, "rpt_charts", acSaveYes
    Set rpt = Nothing
    DoCmd.OpenReport "rpt_charts", acViewPreview, , , acWindowNormal
End If

    On Error Resume Next
    'rsChart is global, so keep it open.
    If rsDates.State <> 0 Then rsDates.Close
    Set rsDates = Nothing
    Exit Sub

    Call sb_error_handler(Err, "sb_chart_load_or_export")
    Resume exit_function

End Sub
Your Guide to Achieving IT Business Success

The IT Service Excellence Tool Kit has best practices to keep your clients happy and business booming. Inside, you’ll find everything you need to increase client satisfaction and retention, become more competitive, and increase your overall success.

Mike EghtebasDatabase and Application DeveloperAuthor Commented:
Thank you for good suggestions.

There is an existing excel chart; is there a way to kind of copy and paste a chart from excel into an access report and link its record source to a sql in access?

Never tried that but you can put nonUpdatable version ... as Img file
Sayad Aziz AhmadCommented:
from Insert ---> Object ---->Create From File ----- Select the loacation of ur excel file.

I know it's dirty, but i use rectangle shapes and control their hieght valus from VBA, based on the results on my query.
Gives me a much more controlable graph....

As for dumping into excel, I can give you some code that takes a screenshot of a form (would work with report too), copies it to clipboard and pastes to a destination:

'This in a new module
Option Compare Database
Option Explicit
'INF: How to Retrieve Information from the Clipboard (ACC 7.0, 97)
'   Function ClipBoard_GetData()

'INF: How to Send Information to the Clipboard (ACC 7.0, 97)
'   Function ClipBoard_SetData(MyString As String)
'INF: How to Capture Screens of Your Forms (ACC 7.0/97) into Clipboard
'   Function ScreenDump()
'Function PrtScn(Alles As Boolean)
    ' Alles = True - Gesamter Bildschirm
    ' Alles = False - Aktives Fenster
'Function ClipBoard_Clear()
      Declare Function OpenClipboard Lib "User32" (ByVal hWnd As Long) As Long
      Declare Function CloseClipboard Lib "User32" () As Long
      Declare Function GetClipboardData Lib "User32" (ByVal wFormat As Long) As Long
      Declare Function SetClipboardData Lib "User32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
      Declare Function EmptyClipboard Lib "User32" () As Long
      Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags&, ByVal dwBytes As Long) As Long
      Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
      Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
      Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
      Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long

      Declare Sub keybd_event Lib "User32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
      Public Const VK_SNAPSHOT = &H2C
   Type RECT_Type
      Left As Long
      Top As Long
      Right As Long
      Bottom As Long
   End Type

   Declare Function GetActiveWindow Lib "User32" () As Long
   Declare Function GetDesktopWindow Lib "User32" () As Long
   Declare Sub GetWindowRect Lib "User32" (ByVal hWnd As Long, lpRect As RECT_Type)

   Declare Function GetDC Lib "User32" (ByVal hWnd As Long) As Long
   Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
   Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc _
                                       As Long, ByVal nWidth As Long, _
                                       ByVal nHeight As Long) As Long
   Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, _
                                       ByVal hObject As Long) As Long

   Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, _
                                       ByVal X As Long, ByVal Y _
                                       As Long, ByVal nWidth As Long, _
                                       ByVal nHeight As Long, _
                                       ByVal hSrcDC As Long, _
                                       ByVal XSrc As Long, _
                                       ByVal YSrc As Long, _
                                       ByVal dwRop As Long) As Long

   Declare Function ReleaseDC Lib "User32" (ByVal hWnd As Long, ByVal hdc As Long) As Long
   Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

   Public Const GHND = &H42
   Public Const CF_TEXT = 1
   Public Const MAXSIZE = 4096

   Global Const SRCCOPY = &HCC0020
   Global Const CF_BITMAP = 2
    Function ClipBoard_GetData()
         Dim hClipMemory As Long
         Dim lpClipMemory As Long
         Dim MyString As String
         Dim retval As Long

         If OpenClipboard(0&) = 0 Then
            MsgBox "Cannot open Clipboard. Another app. may have it open"

            Exit Function
         End If

         ' Obtain the handle to the global memory
         ' block that is referencing the text.
         hClipMemory = GetClipboardData(CF_TEXT)
         If IsNull(hClipMemory) Then
            MsgBox "Could not allocate memory"
            GoTo OutOfHere
         End If

         ' Lock Clipboard memory so we can reference
         ' the actual data string.
         lpClipMemory = GlobalLock(hClipMemory)

         If Not IsNull(lpClipMemory) Then

            MyString = Space$(MAXSIZE)
            retval = lstrcpy(MyString, lpClipMemory)
            retval = GlobalUnlock(hClipMemory)

            ' Peel off the null terminating character.
            MyString = Mid(MyString, 1, InStr(1, MyString, Chr$(0), 0) - 1)
            MsgBox "Could not lock memory to copy string from."
         End If


         retval = CloseClipboard()
         ClipBoard_GetData = MyString

      End Function
    Function ClipBoard_SetData(MyString As String)
         Dim hGlobalMemory As Long, lpGlobalMemory As Long

         Dim hClipMemory As Long, X As Long

         ' Allocate moveable global memory.
         hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)

         ' Lock the block to get a far pointer
         ' to this memory.
         lpGlobalMemory = GlobalLock(hGlobalMemory)

         ' Copy the string to this global memory.
         lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)

         ' Unlock the memory.

         If GlobalUnlock(hGlobalMemory) <> 0 Then
            MsgBox "Could not unlock memory location. Copy aborted."
            GoTo OutOfHere2
         End If

         ' Open the Clipboard to copy data to.
         If OpenClipboard(0&) = 0 Then
            MsgBox "Could not open the Clipboard. Copy aborted."
            Exit Function
         End If

         ' Clear the Clipboard.
         X = EmptyClipboard()

         ' Copy the data to the Clipboard.

         hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)


         If CloseClipboard() = 0 Then
            MsgBox "Could not close Clipboard."
         End If

         End Function

   Function ScreenDump()
      Dim AccessHwnd As Long, DeskHwnd As Long
      Dim hdc As Long
      Dim hdcMem As Long
      Dim Rect As RECT_Type
      Dim junk As Long
      Dim fwidth As Long, fheight As Long
      Dim hBitmap As Long
      DoCmd.Hourglass True
      ' Get window handle to Windows and Microsoft Access
      DeskHwnd = GetDesktopWindow()
      AccessHwnd = GetActiveWindow()
      ' Get screen coordinates of Microsoft Access
      Call GetWindowRect(AccessHwnd, Rect)
      fwidth = Rect.Right - Rect.Left
      fheight = Rect.Bottom - Rect.Top
      ' Get the device context of Desktop and allocate memory
      hdc = GetDC(DeskHwnd)
      hdcMem = CreateCompatibleDC(hdc)
      hBitmap = CreateCompatibleBitmap(hdc, fwidth, fheight)
      If hBitmap <> 0 Then
         junk = SelectObject(hdcMem, hBitmap)
         ' Copy the Desktop bitmap to memory location
         ' based on Microsoft Access coordinates.
         junk = BitBlt(hdcMem, 0, 0, fwidth, fheight, hdc, Rect.Left, _
                       Rect.Top, SRCCOPY)
         ' Set up the Clipboard and copy bitmap
         junk = OpenClipboard(DeskHwnd)
         junk = EmptyClipboard()
         junk = SetClipboardData(CF_BITMAP, hBitmap)
         junk = CloseClipboard()
      End If
      ' Clean up handles
      junk = DeleteDC(hdcMem)
      junk = ReleaseDC(DeskHwnd, hdc)
      DoCmd.Hourglass False
   End Function

Function PrtScn(Alles As Boolean)

If Not Alles Then
    keybd_event VK_SNAPSHOT, 0, 0, 0

    keybd_event VK_SNAPSHOT, 1, 0, 0
End If

End Function

Function ClipBoard_Clear()
  Call OpenClipboard(0&)
  Call EmptyClipboard
  Call CloseClipboard
End Function

Now on your form (this example pastes into a mail):

Dim mailrecipient As String
mailrecipient = "recipient name"

If MsgBox("Is your email open?", vbYesNo, "Mail screen shot") = vbYes Then
    Dim X
    X = PrtScn(False)
    Dim eadr, ebrief As String
    Dim meineOlApp As Outlook.Application
    Dim meinAdressat As Recipient
    Dim meinElement As MailItem
  eadr = mailrecipient
  Set meineOlApp = New Outlook.Application
  Set meinElement = meineOlApp.CreateItem(olMailItem)
  Set meinAdressat = meinElement.Recipients.Add(eadr)
  meinElement.Subject = "Screenshot of Database"
  meinElement.Body = X
  SendKeys "{TAB}", True
  SendKeys "^v", True
    End If

Jim HornSQL Server Data DudeCommented:
>is there a way to kind of copy and paste a chart from excel into an access report
Never tried it, but since they would both be OLE objects, my guess would be yes.  I also have code to paste chart from Access to PowerPoint.

>and link its record source to a sql in access
In code only.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.