¡¡

Ä«Å×°í¸®    ¹é¾÷,¾ÐÃà,°¡Á®¿À±â,³»º¸³»±â(¿öµå,¿¢¼¿¡¦.) Á¶È¸:3052
 Á¦¸ñ    Excel chart creation thru automation

********************************************************************************************

  Excel chart creation thru automation

********************************************************************************************

Private Sub cmdCreateSpreadsheet_Click()

    Dim varArray as Variant

    Dim recSales As Recordset                                      ' Recorset to create chart from

    Dim objExcel As New Excel.Application                     ' Excel object

    DoCmd.Hourglass True                                                       ' Turn on the Hourglass -- to encourage wait by User

    Set recSales = CurrentDb().OpenRecordset("qryMonthlySales")  ' Creating recordset from QueryDef

    recSales.MoveLast                                                                ' Move to the last record to update record count

    recSales.MoveFirst                                                                ' Move to the first record

    varArray = recSales.GetRows(recSales.RecordCount)   ' Load the array with the query results

    recSales.Close                                                                        ' Close the recordset

    objExcel.Workbooks.Add                                                   ' Add a new Excel workbook

    ' ****************************************************************************

    For intFld = 0 To UBound(varArray, 1)                            ' Pass the values from the array into the Excel sheet

        For intRow = 0 To UBound(varArray, 2)

            objExcel.Cells(intRow + 2, intFld + 1).Value = varArray(intFld, intRow)

        Next

    Next

    ' *****************************************************************************

    ' Work on the data as desired using regular Excel commands -- simply recede them with

    ' objExcel as with objExcel.Range("A1:C3").Select

    ' *****************************************************************************

    ' As with modifying a Chart -- see this:

    Set objChart = objExcel.ActiveChart

    With objChart

        .ChartType = xl3DArea

        .HasTitle = True                                                                 ' Add some titles

        .ChartTitle.Text = "Monthly Sales"

        .Axes(xlCategory).HasTitle = True

        .Axes(xlCategory).AxisTitle.Caption = "Month"

        .Axes(xlValue).HasTitle = True

        .Axes(xlValue).AxisTitle.Caption = "Sales"

        .Axes(xlSeriesAxis).HasTitle = True

        .Axes(xlSeriesAxis).AxisTitle.Caption = "Year"

        .HasLegend = False

    End With

    objExcel.ActiveWorkbook.Close True, "C:\BegVBA\MnthSale.XLS"   ' Saving & closing Workbook

    ' Close Excel and free the memory

    Set objChart = Nothing

    Set objExcel = Nothing

    DoCmd.Hourglass False

    objExcel.Quit                                      ' Leave the Excel application

    Exit Sub

 

                                        *** or a more complext example of inserting data and creating a chart therefrom ******

Public Sub CreateChart()

'

' Purpose:      To create an Excel chart from a recordset

'

    Dim recSales        As Recordset            ' Recorset to create chart from

    Dim varArray        As Variant              ' Array of entries from above

    Dim objExcel        As New Excel.Application     ' Excel object

    Dim objChart        As Object         ' Excel chart object

    Dim intFields       As Integer              ' Number of fields in recordset

    Dim intRows         As Integer              ' Number of rows in recordset

    Dim intFld          As Integer              ' Loop index for fields

    Dim intRow          As Integer              ' Loop index for rows

    Dim strRange        As String               ' Range of Excel cells for data

 

    On Error GoTo CreateChart_Err

   

    ' Turn on the hourglass before opening the recordset

    DoCmd.Hourglass True

    Set recSales = CurrentDb().OpenRecordset("qryxMonthlySales")

 

    ' Move to the last record so we get an accurate record count

    recSales.MoveLast

   

    ' Copy the whole recordset into an array, and close the recordset

    recSales.MoveFirst

    varArray = recSales.GetRows(recSales.RecordCount)

   

    ' Determine the number of rows and fields in the array

    intFields = UBound(varArray, 1)

    intRows = UBound(varArray, 2)

 

    ' create a new workbook

    objExcel.Workbooks.Add

 

    ' fill the years and close the recordset

    recSales.MoveFirst

    For intFld = 1 To intFields

        objExcel.Cells(intRow + 1, intFld + 1).Value = recSales.Fields(intFld).Name

    Next

    recSales.Close

     

    ' Pass the values from the array into the Excel sheet

    For intFld = 0 To intFields

        For intRow = 0 To intRows

            objExcel.Cells(intRow + 2, intFld + 1).Value = varArray(intFld, intRow)

        Next

    Next

   

    ' Determine the A1:C2-type reference for the range containing our data

    strRange = "A1:" & Chr$(Asc("A") + intFields) & Format$(intRows + 2)

   

    ' Select the range in the Excel sheet and make it active

    objExcel.Range(strRange).Select

    objExcel.Range(Mid(strRange, 4)).Activate

   

    ' Insert a chart based on the active selection

    objExcel.Application.Charts.Add

   

    ' Add some titles

    Set objChart = objExcel.ActiveChart

    With objChart

        .ChartType = xl3DArea

        .HasTitle = True

        .ChartTitle.Text = "Monthly Sales"

        .Axes(xlCategory).HasTitle = True

        .Axes(xlCategory).AxisTitle.Caption = "Month"

        .Axes(xlValue).HasTitle = True

        .Axes(xlValue).AxisTitle.Caption = "Sales"

        .Axes(xlSeriesAxis).HasTitle = True

        .Axes(xlSeriesAxis).AxisTitle.Caption = "Year"

        .HasLegend = False

    End With

   

    objExcel.ActiveWorkbook.Close True, "C:\BegVBA\MnthSale.XLS"

   

    ' Close Excel and free the memory

    Set objChart = Nothing

    Set objExcel = Nothing

    DoCmd.Hourglass False

    

CreateChart_Exit:

    Exit Sub

 

CreateChart_Err:

    ' Tidy up - ensure all objects are cleared

    Set objChart = Nothing

    objExcel.ActiveWorkbook.Close False

    objExcel.Quit

    Set objExcel = Nothing

    DoCmd.Hourglass False

    MsgBox Err.Number & " - " & Err.Description

    Resume CreateChart_Exit

 

End Sub