IT Soldier Sakuri !!

Oracle使い。いつのまにかIT戦士になってしまったさくりの可哀想な奮闘記。

Oracle活用 Excelからデータを取得する③更新できるメンテナンスツール

R…、Rubyやってるよ!
やってるんだけど、まだ特筆できるようなことないから、ね。


ってことで、やっぱりExcelVBAになっちゃうんだなぁ。
派遣さんや一般職の方にユーザ一覧のメンテナンスをさせたいなぁってことがある。
でもSQLとか使えないし…という時のために、
マスタメンテナンスツールを作ってみた。

表示させるところまでは今までと同じ。
でも一番左に黄色く[更新]って列が追加になってるでしょ?
f:id:itsoldiersakuri:20150813184356p:plain

これは、入力規則で[挿入][更新][削除]を追加しているので、
各作業に合わせて選ぶと、その通りの挙動となる仕組み。
f:id:itsoldiersakuri:20150813184511p:plain


[表示クリア]と[データ取得]は前回と基本的にはほぼ同じ。
(2列目からデータを表示させるとか、そのくらい。)

ただし、[データ取得]に関係するところとして、
[特定のセルに文字が入力されたら実行される]って機能が入ってる。
データが1行入ったら、その一番左の列に入力規則で[挿入][更新][削除]が設定されるようになりました。

あとは、[データ更新]ボタン。
これは単純に一番左の列で[挿入][更新][削除]のどれかが選択されていれば、
その通りに動かすよ!ってこと。

' ************************************************************************************************
' ***
' ***  社員マスタメンテナンス
' ***
' ***   概要:OO4Oを使用。Oracleのデータ取得、挿入、更新、削除処理。
' ***
' ***
' ***   作成者: SAKURI
' ***   作成日: 2015/08/13
' ***
' ************************************************************************************************
Option Explicit

'データクリアボタン押下
Private Sub btnClear_Click()
    '選択した列の内容をクリア
    Range("A3:XFD1048576").ClearContents
    Range("A3:XFD1048576").ClearFormats
    Range("A3:A1048576").Validation.Delete
    'セルA5の選択(複数セル選択した選択範囲のクリアのため)
    Range("A3:A3").Select
    
End Sub

'「全件データ取得」ボタン押下
Private Sub btnAlldata_Click()
On Error GoTo ERR_HANDLER

    Dim OraSession As Object        'セッション
    Dim OraDatabase As Object       'データベース
    Dim rs As Object                'レコードセット
    Dim i As Long
    Dim rownum As Long
    Dim colnum As Integer
    Dim strSQL As String            'SQL文
    Dim maxrownum As Long
    Dim maxcolnum As Long
    
    'すでに表示されている内容のクリア
    Call btnClear_Click
         
    'セッションオブジェクトの生成
    Set OraSession = CreateObject("OracleInProcServer.XOraSession")
    'データベースオブジェクトの生成(接続先を指定)
    Set OraDatabase = OraSession.OpenDatabase("XE", "hr/hr", 0&)
    
    'SQL文
    strSQL = "select * from EMPLOYEES order by 1"

    'SQLを実行してデータを取得
    Set rs = OraDatabase.CreateDynaset(strSQL, 0&)
                                                        
    '[更新]項目
    ActiveSheet.Cells(2, 1) = "更新"
    Range("A2").Interior.Color = RGB(255, 255, 153)
                                                        
    '列名の表示
    rownum = 2
    colnum = 2
    For i = 0 To rs.Fields.Count - 1
        ActiveSheet.Cells(rownum, colnum) = rs(i).Name
        colnum = colnum + 1
    Next
    
    'データの表示(取得したデータを1行ずつExcelに転記)
    rownum = 3
    Do Until rs.EOF
        colnum = 2
        For i = 0 To rs.Fields.Count - 1
            ActiveSheet.Cells(rownum, colnum) = rs(i).Value
            colnum = colnum + 1
        Next
        rs.MoveNext
        rownum = rownum + 1
    Loop
    
    '何行何列目まで表示したか保存
    maxrownum = rownum - 1
    maxcolnum = colnum - 1
        
    '枠線つける
    Range(Cells(2, 1), Cells(maxrownum, maxcolnum)).Borders.LineStyle = xlContinuous
    
    'セル幅自動調整
    Range(Cells(2, 2), Cells(maxrownum, maxcolnum)).Columns.AutoFit
    
    'タイトルに色付け
    Range(Cells(2, 2), Cells(2, maxcolnum)).Interior.Color = RGB(197, 217, 241)
    
    'フィルタ設定
    Range("A2").AutoFilter
                                
    'オブジェクトのクローズ
    rs.Close
    
    '各種オブジェクトの開放
    Set rs = Nothing
    Set OraDatabase = Nothing
    Set OraSession = Nothing
    
    MsgBox ("ヾ(●´∀`●) デキタヨー♪")

QUIT_OPER:
    'オブジェクト変数用に確保したメモリの開放
    Set rs = Nothing
    Set OraDatabase = Nothing
    Set OraSession = Nothing
    Exit Sub
    
ERR_HANDLER:    'エラー処理
    'エラー番号とエラー内容の表示
    MsgBox Err.Number & ")" & Err.Description
    Err.Clear
    GoTo QUIT_OPER

End Sub

'特定のセルに文字が入力されたら実行される
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim MyRow As Long
    Dim MyCol As Integer
        MyRow = Target.Row
        MyCol = Target.Column
        
        '1行目と2行目は無視
        If MyRow = 1 Or MyRow = 2 Then
            Exit Sub
        End If
              
        '社員NOが入っていたら[更新]列に入力規則を設定
        If MyCol = 2 Then
            ActiveSheet.Cells(MyRow, MyCol - 1).ClearContents
            With ActiveSheet.Cells(MyRow, MyCol - 1).Validation
                .Delete
                .Add Type:=xlValidateList, _
                        Operator:=xlEqual, _
                        Formula1:="挿入,更新,削除"
            End With
        End If
End Sub

'「データ更新」ボタン押下
Private Sub btnIUD_Click()
On Error GoTo ERR_HANDLER

    Dim OraSession As Object        'セッション
    Dim OraDatabase As Object       'データベース
    Dim rownum As Long
    Dim colnum As Integer
    Dim strSQL As String
    Dim i As Long
        
    'セッションオブジェクトの生成
    Set OraSession = CreateObject("OracleInProcServer.XOraSession")
    'データベースオブジェクトの生成
    Set OraDatabase = OraSession.OpenDatabase("xe", "hr/hr", 0&)
    
    '[更新]列がブランクになるまで実施
    rownum = 3
    Do Until ActiveSheet.Cells(rownum, 2) = ""
        
        Select Case ActiveSheet.Cells(rownum, 1)
            Case "挿入"
                
                '初期化
                strSQL = ""
                strSQL = "INSERT INTO EMPLOYEES (EMPLOYEE_ID,FIRST_NAME,LAST_NAME,EMAIL,PHONE_NUMBER,HIRE_DATE,JOB_ID," & _
                         "SALARY,COMMISSION_PCT,MANAGER_ID,DEPARTMENT_ID) VALUES ('" & _
                          ActiveSheet.Cells(rownum, 2) & "','" & ActiveSheet.Cells(rownum, 3) & "','" & ActiveSheet.Cells(rownum, 4) & "','" & _
                          ActiveSheet.Cells(rownum, 5) & "','" & ActiveSheet.Cells(rownum, 6) & "','" & ActiveSheet.Cells(rownum, 7) & "','" & _
                          ActiveSheet.Cells(rownum, 7) & "','" & ActiveSheet.Cells(rownum, 9) & "','" & ActiveSheet.Cells(rownum, 10) & "','" & _
                          ActiveSheet.Cells(rownum, 11) & "','" & ActiveSheet.Cells(rownum, 12) & "')"
                          MsgBox (strSQL)
                OraDatabase.ExecuteSQL strSQL
        
            Case "更新"
            
                '初期化
                strSQL = ""
                strSQL = "UPDATE EMPLOYEES SET FIRST_NAME = '" & ActiveSheet.Cells(rownum, 3) & "' , LAST_NAME = '" & ActiveSheet.Cells(rownum, 4) & "' ," & _
                         "EMAIL = '" & ActiveSheet.Cells(rownum, 5) & "' , PHONE_NUMBER = '" & ActiveSheet.Cells(rownum, 6) & "' ," & _
                         "HIRE_DATE = '" & ActiveSheet.Cells(rownum, 7) & "' , JOB_ID = '" & ActiveSheet.Cells(rownum, 8) & "' ," & _
                         "SALARY = '" & ActiveSheet.Cells(rownum, 9) & "' , COMMISSION_PCT = '" & ActiveSheet.Cells(rownum, 10) & "' ," & _
                         "MANAGER_ID = '" & ActiveSheet.Cells(rownum, 9) & "' , DEPARTMENT_ID = '" & ActiveSheet.Cells(rownum, 10) & "' " & _
                         "WHERE EMPLOYEE_ID = '" & ActiveSheet.Cells(rownum, 2) & "' "
                OraDatabase.ExecuteSQL strSQL
        
            Case "削除"
            
                '初期化
                strSQL = ""
                'delete文作成
                strSQL = "DELETE FROM EMPLOYEES WHERE EMPLOYEE_ID = '" & ActiveSheet.Cells(rownum, 2) & "'"
                OraDatabase.ExecuteSQL strSQL
        
            Case Else
        
        
        End Select
       
       rownum = rownum + 1
    Loop

    
    '各種オブジェクトの開放
    Set OraDatabase = Nothing
    Set OraSession = Nothing
    
    MsgBox ("カンリョウッ (`・ω・´)ノ")
 
QUIT_OPER:
    'オブジェクト変数用に確保したメモリの開放
    Set OraDatabase = Nothing
    Set OraSession = Nothing
    Exit Sub
ERR_HANDLER:    'エラー処理
    'エラー番号とエラー内容の表示
    MsgBox Err.Number & ")" & Err.Description
    Err.Clear
    GoTo QUIT_OPER

End Sub

こーゆーメンテナンス業務って好きなんだけど、
ルーチンワークを自分で持ってると怒られる年齢になってきたので、
業務改善的として挙げてみようかな。