PGlabo: VB6.0 アーカイブ

【VB6.0】の記事一覧

[VB6.0] CSVの読み込み: (2005/10/13)
[VB6.0] CSVを出力: (2005/10/13)
[VB6.0] フォルダ内の検索: (2005/10/13)
[VB6.0] フォルダ作成・削除: (2005/10/13)
[VB6.0] マウスポインタ: (2005/10/13)
[VB6.0] Shell 関数（パラメータ付き）: (2005/10/13)
[VB6.0|Oracle] oo4o 関数: (2005/10/13)
[VB6.0|MySQL] MySQLにODBCで接続: (2005/10/11)
[VB6.0|Access] ADOで接続: (2005/10/11)
[VB6.0|Access] DAOで接続: (2005/10/11)
[VB6.0] 配列重複チェック: (2005/09/30)
[VB6.0] Excelの操作: (2005/09/29)
[VB6.0] 文字列バイトチェック: (2005/08/11)
[VB6.0] 配列のソート: (2005/08/10)
[VB6.0] 時間計測: (2005/08/04)
[VB6.0|Oracle] Excelにグラフを表示: (2005/07/30)
[VB6.0|Oracle] パラメータを使ったSQL文: (2005/07/30)
[VB6.0|Oracle] DB接続: (2005/07/30)
[VB6.0] 全フォームのUnload: (2005/07/30)
[VB6.0] 二重起動防止: (2005/07/30)
[INI|VB6.0] INIファイル（初期化ファイル）の呼び出し方: (2005/07/30)
[INI|VB6.0] INIファイル（初期化ファイル）の書き込み方: (2005/07/30)

[VB6.0] CSVの読み込み

Dim FileNo As Integer
Dim strLine As String
Dim strInput(1 To 5) As String

FileNo = FreeFile

Open App.Path & "\Sample.csv" For Input As #FileNo

    Do While Not EOF(FileNo)

    

        '一行すべて読み込み

        Line Input #FileNo, strLine

    

        '一つずつ読み込み

        Input #FileNo, strInput(1), strInput(2), strInput(3), strInput(4), strInput(5)

    Loop    

Close #FileNo

2005 / 10 / 13

[VB6.0] CSVを出力

Dim FileNo As Integer Dim strOutput As String

FileNo = FreeFile
Open App.Path & "\Sample.csv" For Output As #FileNo '新規作成（上書き）の場合
'Open App.Path & "\Sample.csv" For Append As #FileNo '追加の場合

'一行すべて出力
strOutput = "あ,い,う,え,お"
Print #FileNo, strOutput

'一つずつ出力
Write #FileNo, "か", "き", "く", "け", "こ"

Close #FileNo

2005 / 10 / 13

[VB6.0] フォルダ内の検索

'例１：

Dim DireFile As String

'検索したいフォルダを指定

DireFile = Dir$(App.Path & "\", vbDirectory) '指定フォルダ内をすべて検索する場合

'DireFile = Dir$(App.Path & "\*.*") '指定フォルダ内のファイルのみ検索する場合

Do While DireFile <> ""

    If (GetAttr(App.Path & "\" & DireFile)) And (vbDirectory) = vbDirectory Then

        If Right(DireFile, 4) = ".csv" Then

            MsgBox "ファイルあり"

        End If

    End If

    DireFile = Dir$

Loop

'例２：フルパスがわかっている場合

Dim FileName As String

FileName = Dir(App.Path) ' & "\Sample.csv")

'ファイルがない場合 FileName=""

If FileName <> "" Then

    MsgBox "ファイルあり"

End If

2005 / 10 / 13

[VB6.0] フォルダ作成・削除

'フォルダ作成 MkDir$ App.Path & "\DATA"

'フォルダ削除（フォルダ内にファイルが存在するとエラー）
RmDir$ App.Path & "\DATA"

2005 / 10 / 13

[VB6.0] マウスポインタ

'砂時計 Screen.MousePointer = vbHourglass

'設定解除
Screen.MousePointer = vbDefault

2005 / 10 / 13

[VB6.0] Shell 関数（パラメータ付き）

'--- メインフォーム

Dim Hdl As Variant
Dim Path As String
Dim Param As String

'Shell用フォームに送るパラメータ
Param = "パラメータ,001"
'パラメータ付きのパス
Path = "C:\ShellTest.exe" & " " & Param

'exeの呼び出し
Hdl = Shell(Path, 1)
'アクティブにするフォーム
AppActivate "Shell用フォーム" 'exeのForm.Caption

'--- Shell用フォーム（exe）

Dim x As String
x = Command()

'パラメータの受け取り
MsgBox "メインフォームからのパラメータ＝ " & x

2005 / 10 / 13

[VB6.0|Oracle] oo4o 関数

Option Explicit

Global oraSESSION As Object
Global oraDATABASE As Object

Global Const ORADB_DEFAULT = &H0
Global Const ORADYN_DEFAULT = &H0

Function oraCONNECT(ByVal USERID As String, ByVal PASS As String, ByVal TNS As String) As Boolean
    Dim FLAG As Boolean
    Dim CONNECTID As String
    On Error GoTo Err1

    FLAG = True

    CONNECTID = USERID & "/" & PASS

    Set oraSESSION = CreateObject("OracleInProcServer.XOraSession")

    Set oraDATABASE = oraSESSION.OpenDatabase(TNS, CONNECTID, ORADB_DEFAULT)

    oraCONNECT = FLAG

    Exit Function

Err1:

    FLAG = False

    oraCONNECT = FLAG

End Function

Function oraSELECT(ByVal strSQL As String, ByRef oraDYNASET As Object) As Boolean
    Dim FLAG As Boolean
    On Error GoTo Err1

    FLAG = True

    Set oraDYNASET = oraDATABASE.CreateDynaset(strSQL, ORADYN_DEFAULT)

    oraSELECT = FLAG

    Exit Function

Err1:

    FLAG = False

    oraSELECT = FLAG

    Debug.Print strSQL

End Function

Function oraEXECUTE(ByVal strSQL As String) As Boolean Dim FLAG As Boolean On Error GoTo Err1

FLAG = True

oraDATABASE.ExecuteSQL strSQL

oraEXECUTE = FLAG
Exit Function

Err1:
FLAG = False
oraEXECUTE = FLAG

End Function

2005 / 10 / 13

[VB6.0|MySQL] MySQLにODBCで接続

'実行時バインディング（参照設定：なし）
Dim OdbcConn As Object
Dim OdbcRS As Object

    Set OdbcConn = CreateObject("ADODB.Connection")

    Set OdbcRS = CreateObject("ADODB.Recordset")

    

    OdbcConn.open "Driver={MySQL ODBC 3.51 Driver};Uid=**;Pwd=**;Database=[DB名]"

    OdbcRS.open [SQL文], OdbcConn

    '終了処理
    OdbcRS.Close
    Set OdbcRS = Nothing
    OdbcConn.Close
    Set OdbcConn = Nothing

2005 / 10 / 11

[VB6.0|Access] ADOで接続

'事前バインディングの場合（参照設定：Microsoft ActiveX Data Objects 2.7 Library） Dim AdoConn As New ADODB.Connection Dim AdoRS As New ADODB.Recordset

AdoConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\sample.mdb"
AdoRS.Open [SQL文かテーブル名], AdoConn

'実行時バインディングの場合（参照設定：なし）
Dim AdoConn As Object
Dim AdoRS As Object

    Set AdoConn = CreateObject("ADODB.Connection")

    Set AdoRS = CreateObject("adodb.recordset")

    AdoConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\sample.mdb"

    AdoRS.Open [SQL文かテーブル名], AdoConn

    '終了処理
    AdoRS.Close
    Set AdoRS = Nothing
    AdoConn.Close
    Set AdoConn = Nothing

2005 / 10 / 11

[VB6.0|Access] DAOで接続

'事前バインディングの場合（参照設定：Microsoft DAO 3.6 Object Library）
Dim DaoWS As DAO.Workspace
Dim DaoDB As DAO.Database
Dim DaoRS As DAO.Recordset

    Set DaoWS = DBEngine.Workspaces(0)

    Set DaoDB = DaoWS.OpenDatabase("C:\sample.mdb")

    Set DaoRS = DaoDB.OpenRecordset([SQL文かテーブル名], dbOpenDynaset)

    '終了処理
    DaoRS.Close
    Set DaoRS = Nothing
    DaoDB.Close
    Set DaoDB = Nothing
    DaoWS.Close
    Set DaoWS = Nothing

2005 / 10 / 11

[VB6.0] 配列重複チェック

'重複チェック

For i = 1 To Cnt

    For j = 1 To Cnt - i

        If Array(i) =Array(i + j) Then

            'Array(i) とArray(i + j)が重複

            [重複の場合の処理]

        End If

        

    Next j

Next i

2005 / 09 / 30

[VB6.0] Excelの操作

'-----------------------------------------------------------
' ■ 既存のExcelファイルを開く
'-----------------------------------------------------------

Dim xlApp    As Excel.Application

Dim XlBook   As Excel.Workbook

Dim XlSheet  As Excel.Worksheet



'--- Excel設定

Set xlApp = CreateObject("Excel.Application")

Set XlBook = xlApp.Workbooks.Open("開きたいExcelのパス")

Set XlSheet = XlBook.Worksheets("シート名")



'エラー音の設定

xlApp.DisplayAlerts = True



'アプリケーションの表示・非表示

xlApp.Visible = True



'Excelの処理

With XlSheet

    'セルの指定

    .Cells(Row, Col) = "値"

    '複数セルの指定（セル(1,1)～セル(Row,Col)の範囲）

    .Range(.Cells(1, 1), .Cells(Row, Col)) = "配列名"

    

    'シングルクォーテーションを引っ掛ける（VBA？）

    .Cells(Row, Col).PrefixCharacter

End With



'--- Excel解放

Set XlSheet = Nothing

XlBook.Close

Set XlBook = Nothing

xlApp.Quit

Set xlApp = Nothing

2005 / 09 / 29

[VB6.0] 文字列バイトチェック

'-----------------------------------------------------------
'　■ 文字列バイトチェック ■
'
'　動作：
'　テキストが指定バイト数以下かチェック
'
'　引数：
'　CheckText   = チェックしたいテキスト
'　CheckType   = チェックタイプ
'　ByteNum     = バイト数
'  blnByte     = False(指定バイト以下)、True(指定外)
'
'   * CheckType
'   　1 = 全角文字
'   　2 = 半角英数
'   　3 = 全半角混在
'   　4 = 半角数字
'
'-----------------------------------------------------------

Private Function TextByteCheck( _

    ByVal CheckText As String, _

    ByVal CheckType As Integer, _

    ByVal ByteNum As Integer, _

    ByRef blnByte As Boolean)

    Select Case CheckType

        Case 1 '全角文字

            If LenB(StrConv(CheckText, vbFromUnicode)) <= ByteNum _

            And Len(CheckText) * 2 = LenB(StrConv(CheckText, vbFromUnicode)) Then

                blnByte = False

            Else

                blnByte = True

            End If

        Case 2 '半角英数

            If LenB(StrConv(CheckText, vbFromUnicode)) <= ByteNum _

            And Len(CheckText) = LenB(StrConv(CheckText, vbFromUnicode)) Then

                blnByte = False

            Else

                blnByte = True

            End If

        Case 3 '全半角混在

            If LenB(StrConv(CheckText, vbFromUnicode)) <= ByteNum Then

                blnByte = False

            Else

                blnByte = True

            End If

        Case 4 '半角数字

            If LenB(StrConv(CheckText, vbFromUnicode)) <= ByteNum _

            And IsNumeric(CheckText) Then

                blnByte = False

            Else

                blnByte = True

            End If

        Case Else

            blnByte = True

            

    End Select

End Function

2005 / 08 / 11

[VB6.0] 配列のソート

'-----------------------------------------------------
'　配列ソート（String）
'
'　引数：
'　strArray()   = 配列名
'　lngStart     = ソートを開始する要素番号
'　lngEnd       = ソートを終了する要素番号
'
'-----------------------------------------------------
Public Sub StrQuickSort _
    (ByRef strArray() As String, _
     ByVal lngStart As Long, _
     ByVal lngEnd As Long, _
     Optional ByVal lngCompare As Long)



 Dim lngBaseNumber As Long                                  '中央の要素番号を格納する変数

 Dim lngBaseValue As String                                 '基準値を格納する変数

 Dim lngCounter As Long                                     '格納位置カウンタ

 Dim lngBuffer As String                                    '値をスワップするための作業域

 Dim i As Long                                              'ループカウンタ

 

    If lngStart >= lngEnd Then Exit Sub                     '終了番号が開始番号以下の場合、プロシージャを抜ける

    lngBaseNumber = (lngStart + lngEnd) \ 2                 '中央の要素番号を求める

    lngBaseValue = strArray(lngBaseNumber)                  '中央の値を基準値とする

    strArray(lngBaseNumber) = strArray(lngStart)            '中央の要素に開始番号の値を格納

    lngCounter = lngStart                                   '格納位置カウンタを開始番号と同じにする

    For i = (lngStart + 1) To lngEnd Step 1                 '開始番号の次の要素から終了番号までループ

        If strArray(i) < lngBaseValue Then                  '値が基準値より小さい場合

            lngCounter = lngCounter + 1                     '格納位置カウンタをインクリメント

            lngBuffer = strArray(lngCounter)                'strArray(i) と strArray(lngCounter) の値をスワップ

            strArray(lngCounter) = strArray(i)

            strArray(i) = lngBuffer

        End If

    Next i

    strArray(lngStart) = strArray(lngCounter)               'strArray(lngCounter) を開始番号の値にする

    strArray(lngCounter) = lngBaseValue                     '基準値を strArray(lngCounter) に格納

    Call StrQuickSort(strArray(), lngStart, lngCounter - 1)    '分割された配列をクイックソート(再帰)

    Call StrQuickSort(strArray(), lngCounter + 1, lngEnd)      '分割された配列をクイックソート(再帰)

End Sub

'-----------------------------------------------------
'　配列ソート（Long）
'
'　引数：
'　strArray()   = 配列名
'　lngStart     = ソートを開始する要素番号
'　lngEnd       = ソートを終了する要素番号
'
'-----------------------------------------------------
Public Sub LngQuickSort _
    (ByRef lngArray() As Long, _
     ByVal lngStart As Long, _
     ByVal lngEnd As Long)

 Dim lngBaseNumber As Long                                  '中央の要素番号を格納する変数

 Dim lngBaseValue As Long                                   '基準値を格納する変数

 Dim lngCounter As Long                                     '格納位置カウンタ

 Dim lngBuffer As Long                                      '値をスワップするための作業域

 Dim i As Long                                              'ループカウンタ

 

    If lngStart >= lngEnd Then Exit Sub                     '終了番号が開始番号以下の場合、プロシージャを抜ける

    lngBaseNumber = (lngStart + lngEnd) \ 2                 '中央の要素番号を求める

    lngBaseValue = lngArray(lngBaseNumber)                  '中央の値を基準値とする

    lngArray(lngBaseNumber) = lngArray(lngStart)            '中央の要素に開始番号の値を格納

    lngCounter = lngStart                                   '格納位置カウンタを開始番号と同じにする

    For i = (lngStart + 1) To lngEnd Step 1                 '開始番号の次の要素から終了番号までループ

        If lngArray(i) < lngBaseValue Then                  '値が基準値より小さい場合

            lngCounter = lngCounter + 1                     '格納位置カウンタをインクリメント

            lngBuffer = lngArray(lngCounter)                'lngArray(i) と lngArray(lngCounter) の値をスワップ

            lngArray(lngCounter) = lngArray(i)

            lngArray(i) = lngBuffer

        End If

    Next i

    lngArray(lngStart) = lngArray(lngCounter)               'lngArray(lngCounter) を開始番号の値にする

    lngArray(lngCounter) = lngBaseValue                     '基準値を lngArray(lngCounter) に格納

    Call LngQuickSort(lngArray(), lngStart, lngCounter - 1)    '分割された配列をクイックソート(再帰)

    Call LngQuickSort(lngArray(), lngCounter + 1, lngEnd)      '分割された配列をクイックソート(再帰)

End Sub

2005 / 08 / 10

[VB6.0] 時間計測

Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Dim StartTime As Long
Dim EndTime As Long
Dim JobTime As Long
StartTime = timeGetTime

[処理]

EndTime = timeGetTime

JobTime = (EndTime - StartTime)

JobTime = Format(JobTime, "0.000")

MsgBox JobTime & "秒"

2005 / 08 / 04

[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

[VB6.0|Oracle] パラメータを使ったSQL文

Option Explicit

'--- パラメータ入出力

Public Const ORAPARM_INPUT = 1

Public Const ORAPARM_OUTPUT = 2

Public Const ORAPARM_BOTH = 3

'--- パラメータタイプ（NVARCHAR2 は VARCHAR2 でできた。）

Public Const ORATYPE_VARCHAR2 = 1

Public Const ORATYPE_NUMBER = 2

Public Const ORATYPE_SINT = 3

Public Const ORATYPE_FLOAT = 4

Public Const ORATYPE_STRING = 5

Public Const ORATYPE_VARCHAR = 9

Public Const ORATYPE_DATE = 12

Public Const ORATYPE_UINT = 68

Public Const ORATYPE_CHAR = 96

Public Const ORATYPE_CHARZ = 97

Public Const ORATYPE_CURSOR = 102



Public Function Ora_Insert ( _

    ByVal colNo As String, _

    ByVal colName As String, _

    ByVal colBirth As String, _

    ByVal colRole As String, _

    ByVal colMemo As String, _

    ByVal OraSession As Object, _

    ByVal OraDatabase As Object)

    

    '--- パラメータ追加

    OraDatabase.Parameters.Add "pNo", 0, ORAPARM_INPUT

    OraDatabase.Parameters("pNo").serverType = ORATYPE_VARCHAR2

    OraDatabase.Parameters.Add "pName", 0, ORAPARM_INPUT

    OraDatabase.Parameters("pName").serverType = ORATYPE_VARCHAR2

    OraDatabase.Parameters.Add "pBirth", 0, ORAPARM_INPUT

    OraDatabase.Parameters("pBirth").serverType = ORATYPE_NUMBER

    OraDatabase.Parameters.Add "pRole", 0, ORAPARM_INPUT

    OraDatabase.Parameters("pRole").serverType = ORATYPE_VARCHAR2

    OraDatabase.Parameters.Add "pMemo", 0, ORAPARM_INPUT

    OraDatabase.Parameters("pMemo").serverType = ORATYPE_VARCHAR2

    

    If Err <> 0 Or OraDatabase.LastServerErr <> 0 Then

        MsgBox "パラメータ追加に失敗しました。" & Chr(10) & Err & ": " _

                & Error & Chr(10) & "oo4o: " & OraDatabase.LastServerErrText

        End

    End If

    

    OraSession.BeginTrans

        

    '--- パラメータ格納

    OraDatabase.Parameters("pNo").Value = colNo

    OraDatabase.Parameters("pName").Value = colName

    OraDatabase.Parameters("pBirth").Value = colBirth

    OraDatabase.Parameters("pRole").Value = colRole

    OraDatabase.Parameters("pMemo").Value = colMemo

    

    '--- SQL文にパラメータ

    Dim strSql As String

    strSql = "INSERT INTO YAMADA.SAMPLETABLE VALUES _

                  (:pNo, :pName, :pBirth, :pRole, :pMemo)"

    OraDatabase.ExecuteSQL (strSql)

    OraSession.CommitTrans

End Function

'*** 後処理

Private Sub Form_Unload(Cancel As Integer)

'----- パラメータ解消
OraDatabase.Parameters.Remove "pNo"
OraDatabase.Parameters.Remove "pName"
OraDatabase.Parameters.Remove "pBirth"
OraDatabase.Parameters.Remove "pRole"
OraDatabase.Parameters.Remove "pMemo"

'----- oo4o 接続解除
Set OraDatabase = Nothing
Set OraSession = Nothing

End Sub

注： OraSession と OraDatabase は、DBを開いたところから引数でもってくること！

2005 / 07 / 30

[VB6.0|Oracle] DB接続

'----- データベース関連 -----
Private OraSession As Object    'Oracle セッションオブジェクト
Private OraDatabase As Object   'Oracle データベースオブジェクト



Private Sub Form_Load()

    Dim OraDB As String     'Oracle サービス名(別名)

    Dim OraUser As String   'Oracle ユーザー名

    Dim OraPass As String   'Oracle パスワード

    

    

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

    

    '----- エラートラップ開始

    On Local Error Resume Next

    

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

    'frmLogo に「データベース接続中 …」表示

    Load frmLogo

    frmLogo.Show

    DoEvents

    

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

    

    '-----iniファイル 接続

    Call basIniFile.LoadIniFile

    

    '----- サービス、ユーザー設定

    OraDB = basIniFile.pOraDB

    OraUser = basIniFile.pOraUser

    OraPass = basIniFile.pOraPass

    

    

    '----- oo4o 接続

    

    Set OraSession = CreateObject("OracleInProcServer.XOraSession")

    If Err <> 0 Then

        MsgBox "データベースに接続出来ません。" & Chr(10) & "CreateObject - Oracle oo4o エラー"

        End

    End If

    

    Set OraDatabase = _

        OraSession.OpenDatabase(OraDB, OraUser & "/" & OraPass, ORADB_DEFAULT)

    If Err <> 0 Then

        MsgBox "データベースに接続出来ません。" & Chr(10) & Err & ": " & Error

        End

    End If

    

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

    

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

    Unload frmLogo

    

    '----- エラートラップ終了

    On Local Error GoTo 0

    

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

End Sub

2005 / 07 / 30

[VB6.0] 全フォームのUnload

'--- メインのフォームのForm_Unloadに書く

Private Sub Form_Unload(Cancel As Integer)
Dim i As Integer
For i = Forms.Count - 1 To 0 Step -1
Unload Forms(i)
Next i
End Sub

2005 / 07 / 30

[VB6.0] 二重起動防止

'--- 標準モジュールに書く

Private Sub Main()
If App.PrevInstance Then End
frmMain.Show
End Sub

プロジェクト→プロジェクトのプロパティ→全般タブ
スタートアップの設定→Sub Mainを選択

2005 / 07 / 30

[INI|VB6.0] INIファイル（初期化ファイル）の呼び出し方

'■モジュール（basIniFile.bas）

Option Explicit

Private Declare Function GetPrivateProfileString Lib "kernel32" _

    Alias "GetPrivateProfileStringA" ( _

    ByVal lpApplicationName As String, _

    ByVal lpKeyName As Any, _

    ByVal lpDefault As String, ByVal lpReturnedString As String, _

    ByVal nSize As Long, ByVal lpFileName As String) As Long

Private Const FileName As String = "SampleTable.ini"

Private iniName As String

Private iniSection As String

Private iniKey As String

Private iniLen As String * 255

Private L As Boolean

Private DB As String

Private User As String

Private Pass As String

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

Public Sub LoadIniFile()

    iniName = App.Path & "\" & FileName

    iniSection = "ORACLE"   'iniファイル セクション

    

    '--- Oracleサービス名

    iniKey = "OraDatabase"  'iniファイル キー

    iniLen = Space$(255)    'Bufferの初期化

    L = GetPrivateProfileString(iniSection, iniKey, "Error", iniLen, Len(iniLen), iniName)

    DB = Trim$(Left(iniLen, InStr(iniLen, Chr(0)) - 1))

    

    '--- Oracleユーザー名

    iniKey = "OraUserName"  'iniファイル キー

    iniLen = Space$(255)    'Bufferの初期化

    L = GetPrivateProfileString(iniSection, iniKey, "Error", iniLen, Len(iniLen), iniName)

    User = Trim$(Left(iniLen, InStr(iniLen, Chr(0)) - 1))

    

    '--- Oracleパスワード

    iniKey = "OraPassword"  'iniファイル キー

    iniLen = Space$(255)    'Bufferの初期化

    L = GetPrivateProfileString(iniSection, iniKey, "Error", iniLen, Len(iniLen), iniName)

    Pass = Trim$(Left(iniLen, InStr(iniLen, Chr(0)) - 1))

End Sub

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

Public Property Get pgOraDB()

    pgOraDB = DB

End Property

Public Property Get pgOraUser()

    pgOraUser = User

End Property

Public Property Get pgOraPass()

    pgOraPass = Pass

End Property

'■呼び出し方

'-----iniファイル接続
Call basIniFile.LoadIniFile

'----- サービス、ユーザー設定
OraDB = basIniFile.pgOraDB
OraUser = basIniFile.pgOraUser
OraPass = basIniFile.pgOraPass

2005 / 07 / 30

[INI|VB6.0] INIファイル（初期化ファイル）の書き込み方

'■モジュール（basIniFile.bas）

Option Explicit

Private Declare Function WritePrivateProfileString Lib "kernel32" _
Alias "WritePrivateProfileStringA" ( _
ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, ByVal lpString As Any, _
ByVal lpFileName As String) As Long

Private Const FileName As String = "SampleTable.ini"
Private iniName As String
Private iniSection As String
Private iniKey As String
Private L As Boolean

Private NewDB As String

Public Sub SaveIniFile()

　　iniName = App.Path & "\" & FileName
　　iniSection = "ORACLE" 'iniファイルセクション
　　iniKey = "OraDatabase" 'iniファイルキー

　　L = WritePrivateProfileString(iniSection, iniKey, NewDB, iniName)

End Sub

Public Property Let plOraDB(ByVal strDBName As String)
　　NewDB = strDBName
End Property

'■呼び出し方

basIniFile.plOraDB = "OraDB_NewName"
basIniFile.SaveIniFile

2005 / 07 / 30