Oracle活用 Excelからデータを取得する③更新できるメンテナンスツール
R…、Rubyやってるよ!
やってるんだけど、まだ特筆できるようなことないから、ね。
ってことで、やっぱりExcelVBAになっちゃうんだなぁ。
派遣さんや一般職の方にユーザ一覧のメンテナンスをさせたいなぁってことがある。
でもSQLとか使えないし…という時のために、
マスタメンテナンスツールを作ってみた。
表示させるところまでは今までと同じ。
でも一番左に黄色く[更新]って列が追加になってるでしょ?
これは、入力規則で[挿入][更新][削除]を追加しているので、
各作業に合わせて選ぶと、その通りの挙動となる仕組み。
[表示クリア]と[データ取得]は前回と基本的にはほぼ同じ。
(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
こーゆーメンテナンス業務って好きなんだけど、
ルーチンワークを自分で持ってると怒られる年齢になってきたので、
業務改善的として挙げてみようかな。