PGlabo

« [VB6.0|Oracle] パラメータを使ったSQL文 | メイン | [VB6.0] 時間計測 »

2005年07月30日

[VB6.0|Oracle] Excelにグラフを表示

'■frmMain

Option Explicit

'--- Oracle関連（参照設定＝Oracle InProc Server 4.0 Type Library）

Private OraSession As Object

Private OraDatabase As Object

Private OraMaxCols As Integer

Private OraMaxRows As Integer

'--- Excel関連（参照設定＝Microsoft Excel 9.0 Object Library）

Private exlApp As Excel.Application

Private exlBook As Excel.Workbook

Private exlSheet As Excel.Worksheet

Private exlChart As Excel.Chart

Private SheetName As String     'データを代入するシート名

Private Sub Form_Load()

　　'--- Oracleに接続

　　If basOraOpenClose.OraOpen(OraSession, OraDatabase) = False Then

　　　　MsgBox (OraDatabase.LastServerErrText)

　　End If

End Sub



Private Sub Form_Unload(Cancel As Integer)

　　'--- Oracleの接続解除

　　If basOraOpenClose.OraClose(OraSession, OraDatabase) = False Then

　　　　MsgBox "Oracle接続解除エラー"

　　End If

End Sub

'===================================================================

'■EXCELでグラフを表示

'===================================================================

Private Sub btn1_Click()

　　'--- Excelを開く

　　Call basExcelOpenClose.ExcelOpen(exlApp, exlBook, exlSheet, exlChart, SheetName)

　　'--- OracleデータをExcelに代入

　　Call basExcelCtrl.SetCells( _

　　　　OraDatabase, exlApp, exlBook, exlSheet, exlChart, SheetName, OraMaxRows, OraMaxCols)

　　'--- Excelシートからグラフ作成

　　Call basExcelCtrl.SetGraph(exlSheet, exlChart, SheetName, OraMaxRows, OraMaxCols)

　　'--- Excelを閉じる

　　Call basExcelOpenClose.ExcelClose(exlApp, exlBook)

    

End Sub

'■basOraOpenClose

Option Explicit

'===================================================================

'

'■Oracleの接続

'　引数：OraSessionオブジェクト、OraDatabaseオブジェクト

'　戻値：True（正常）、False（エラー）

'

'===================================================================

Public Function OraOpen(ByRef OraSess As Object, ByRef OraDB As Object) As Boolean

　　Dim OraDbName As String

　　Dim OraUserPass As String

    

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

　　'Oracle設定

　　OraDbName = "OraDB2"            'サービス名

　　OraUserPass = "@@@@/@@@@"   'ユーザー名/パスワード

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

       

　　'--- アイキャッチの表示

　　Load frmLogo

　　frmLogo.Show

　　DoEvents

    

　　Set OraSess = CreateObject("OracleInProcServer.XOraSession")

　　Set OraDB = OraSess.OpenDatabase(OraDbName, OraUserPass, ORADB_DEFAULT)

　　OraOpen = True

    

　　'--- /アイキャッチの終了

　　Unload frmLogo

    

End Function

'===================================================================

'

'■Oracleの接続解除

'　引数：OraSessionオブジェクト、OraDatabaseオブジェクト

'　戻値：True（正常）、False（エラー）

'

'===================================================================

Public Function OraClose(ByRef OraSess As Object, ByRef OraDB As Object) As Boolean

    

　　Set OraDB = Nothing

　　Set OraSess = Nothing

　　OraClose = True

End Function

'■basExcelOpenClose

Option Explicit

'===================================================================

'

'■EXCELアプリケーションを開く

'　引数：Excelアプリケーション、Excelワークブック、

'　　　　Excelワークシート、Excelグラフ、Sheet名

'

'===================================================================

Public Function ExcelOpen( _

    ByRef xlApp As Excel.Application, ByRef xlBook As Excel.Workbook, _

    ByRef xlSheet As Excel.Worksheet, ByRef xlChart As Excel.Chart, ByRef SheetName As String)

       

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

    'ActiveSheet名

    SheetName = "WeightData"

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

    

    '---------------------------------------------------------------

    'Excelアプリケーションのセット

    '---------------------------------------------------------------

    

    Set xlApp = CreateObject("Excel.Application")

    Set xlBook = xlApp.Workbooks.Add

    Set xlSheet = xlBook.Worksheets.Add     'xlBook.Worksheets(1) = 1番目のシート

    Set xlChart = xlApp.Charts.Add

    

    Sheets("Sheet4").Name = SheetName    'Sheets(1).Name = 1番目のシート

    xlApp.Visible = True

    

End Function

'===================================================================

'

'■EXCELアプリケーションを閉じる

'　引数：Excelアプリケーション、Excelワークブック

'

'===================================================================

Public Function ExcelClose( _

    ByRef xlApp As Excel.Application, ByRef xlBook As Excel.Workbook)

    

    '---------------------------------------------------------------

    'Excelアプリケーションのセット

    '---------------------------------------------------------------

    

    xlBook.Close

    xlApp.Quit

    Set xlApp = Nothing

End Function

'■basExcelCtrl

Option Explicit

'===================================================================

'

'■OracleからEXCELに値を代入

'　引数：OracleDatabaseオブジェクト、

'　　　　Excelアプリケーション、Excelワークブック、

'　　　　Excelワークシート、Excelグラフ、

'　　　　シート名、データレコード数、データフィールド数

'

'===================================================================

Public Function SetCells( _

    ByVal OraDB As Object, _

    ByRef xlApp As Excel.Application, ByRef xlBook As Excel.Workbook, _

    ByRef xlSheet As Excel.Worksheet, ByRef xlChart As Excel.Chart, _

    ByRef SheetName As String, ByRef i As Integer, ByRef j As Integer)

    

    Dim strSql As String

    

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

    'Oracleダイナセット、SQL文

    strSql = "SELECT * FROM WEIGHT" 'ORDER BY DATE ASC"

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

    

    '---------------------------------------------------------------

    'Oracleダイナセットの作成

    '---------------------------------------------------------------

    

    Dim OraDynaset As Object

    Set OraDynaset = OraDB.DbCreateDynaset(strSql, ORADYN_DEFAULT)

    

    

    '---------------------------------------------------------------

    'Excelにダイナセット代入

    '---------------------------------------------------------------

    

    Dim exlRow As Integer   'Excel行番号

    Dim exlCol As Integer   'Excel列番号

    Dim oraCol As Integer   'Oracle列番号

    

    exlRow = 1

    exlCol = 0

    oraCol = -1

    i = 0

    j = 0

    

    '--- Excelにタイトル行を代入

    xlSheet.Cells(1, 1) = "日付"

    xlSheet.Cells(1, 2) = "MY1"

    xlSheet.Cells(1, 3) = "MY2"

    xlSheet.Cells(1, 4) = "MY3"

    

    

    '--- Excelに代入（i =レコード数、j =フィールド数）

    '--- レコード単位の処理

    Do While Not OraDynaset.EOF     'do until OraDynaset.EOF

        exlRow = exlRow + 1

        i = i + 1

        j = 0

        '--- フィールド単位の処理

        Do While j < OraDynaset.Fields.Count    'DBのフィールド数

            exlCol = exlCol + 1

            oraCol = oraCol + 1

            j = j + 1

            xlSheet.Cells(exlRow, exlCol) = OraDynaset.Fields(oraCol).Value

        Loop

        

        exlCol = 0

        oraCol = -1

        OraDynaset.MoveNext

    Loop

    

    Set OraDynaset = Nothing

    

    MsgBox (i & "件のデータを処理しました。")

    

End Function



'===================================================================

'

'■EXCELシート1のデータからグラフの作成

'　引数：Excelアプリケーション、Excelワークブック、

'　　　　Excelワークシート、Excelグラフ、シート名、

'　　　　Oracleレコード数、Oracleフィールド数

'

'===================================================================

Public Function SetGraph( _

    ByRef xlSheet As Excel.Worksheet, ByRef xlChart As Excel.Chart, ByVal SheetName As String, _

    ByVal intRow As Integer, ByVal intCol As Integer)

    

    Dim GraphSheetName As String

    Dim GraphTitle As String

    Dim TitleSize As Integer

    Dim xTitle As String

    Dim yTitle As String

    

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

    'Excelグラフ設定

    GraphSheetName = "WeightGraph"  'グラフシート名

    GraphTitle = "Weight"           'グラフタイトル名

    TitleSize = 14                  'グラフタイトルサイズ

    xTitle = "日付"                 'X軸タイトル名

    yTitle = "Kg"                   'Y軸タイトル名

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

    

    Dim GraphRange As Range

    

    '--- グラフのデータソース、データ系列（縦軸・横軸）

    xlChart.SetSourceData _

        Source:=Sheets(SheetName).Range _

        (Sheets(SheetName).Cells(1, 1), Sheets(SheetName).Cells(intRow + 1, intCol)), _

        PlotBy:=xlColumns

        

    '--- グラフを作る場所、シート名

    xlChart.Location _

        Where:=xlLocationAsNewSheet, Name:=GraphSheetName

    '--- グラフの種類

    xlChart.ChartType = xlLineMarkers

    

    With xlChart

        .HasTitle = True 'グラフタイトル有無

        .ChartTitle.Text = GraphTitle 'グラフタイトル名

        .ChartTitle.Font.Size = TitleSize 'グラフタイトルサイズ

        .Axes(xlCategory, xlPrimary).HasTitle = True 'X軸タイトル有無

        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = xTitle 'X軸タイトル名

        .Axes(xlValue, xlPrimary).HasTitle = True 'Y軸タイトル有無

        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = yTitle 'Y軸タイトル名

    

    End With

    

    xlChart.ApplyDataLabels Type:=xlDataLabelsShowNone, LegendKey:=False

    xlChart.HasDataTable = False

    

End Function

2005 / 07 / 30