sakura:sakura_keyword_sql.kwd
// SQL キーワード定義ファイル // CASE=False AND AS AVG CASE COUNT DISTINCT ELSE END FROM GROUP BY HAVING IN JOIN LEFT MAX MIN ON ORDER BY RIGHT SELECT THEN WHEN WHERE
sakura:thema_dark.col
; テキストエディタ色設定 Ver3 [SakuraColor] C[BRC]=1,1,ffff84,202020,0 C[CAR]=1,0,f7f7f7,3a3a3a,0 C[CBK]=0,0,f2f8f8,202020,0 C[CMT]=1,0,cc9b6a,202020,0 C[CTL]=0,0,c6c6c6,202020,0 C[CVL]=0,0,ffc184,3a3a3a,0 C[DFA]=0,0,202020,ffc184,0 C[DFC]=0,0,202020,c0fdbd,0 C[DFD]=0,0,202020,f2f8f8,0 C[EBK]=0,0,222827,202020,0 C[EOF]=1,0,ff9999,0c0c0c,0 C[EOL]=1,1,202020,202020,0 C[FN2]=1,0,202020,ffff9e,0 C[FN3]=1,0,202020,9eff9e,0 C[FN4]=1,0,202020,9eceff,0 C[FN5]=1,0,202020,ff9eff,0 C[FND]=1,0,202020,9effff,0 C[HDC]=0,0,84ff84,202020,0 C[IME]=1,0,a791ff,3a3a3a,0 C[KW1]=1,0,ffff84,202020,0 C[KW2]=1,0,84c1ff,202020,0 C[KW3]=1,0,ff84c1,202020,0 C[KW4]=0,0,8484ff,202020,0 C[KW5]=0,0,8484ff,202020,0 C[KW6]=0,0,8484ff,202020,0 C[KW7]=0,0,8484ff,202020,0 C[KW8]=0,0,8484ff,202020,0 C[KW9]=0,0,8484ff,202020,0 C[KWA]=0,0,8484ff,202020,0 C[LNO]=1,0,c6c6c6,3a3a3a,0 C[MOD]=1,1,c6c6c6,3a3a3a,0 C[MRK]=0,0,202020,c08000,0 C[NOT]=0,0,ff9999,f0fbff,0 C[NUM]=0,0,fdfdfd,202020,0 C[PGV]=0,0,f0fbff,ffe6be,0 C[RAP]=1,0,ff9999,202020,0 C[RK1]=1,0,cccc6a,202020,0 C[RK2]=1,0,cccc6a,202020,0 C[RK3]=0,0,cccc6a,202020,0 C[RK4]=0,0,cccc6a,202020,0 C[RK5]=0,0,cccc6a,202020,0 C[RK6]=0,0,cccc6a,202020,0 C[RK7]=0,0,cccc6a,202020,0 C[RK8]=0,0,cccc6a,202020,0 C[RK9]=0,0,cccc6a,202020,0 C[RKA]=0,0,cccc6a,202020,0 C[RUL]=1,0,c6c6c6,3a3a3a,0 C[SEL]=1,0,202020,fdfdfd,0 C[SPC]=0,0,c6c6c6,202020,0 C[SQT]=1,0,80ff80,202020,0 C[TAB]=1,0,c6c6c6,202020,0 C[TXT]=1,0,fdfdfd,202020,0 C[UND]=1,0,ffc184,3a3a3a,0 C[URL]=1,0,c184ff,202020,1 C[VER]=0,0,ff9999,202020,0 C[WQT]=1,0,84ff84,202020,0 C[ZEN]=1,0,646464,202020,0
sakura:sql_formatter.mac
// --------------------------------------------------------------------- // SQL文をフォーマットします。(6割くらいはきれいになると思います) // 文字列キーワードは、大文字変換するようにしています。 // // 以下は、TIPSです。 // サクラエディタの強調表示と組み合わせるとより見やすくなると思います。 // ショートカットなどを設定するとさらに使い勝手は良くなります。 // → https://qiita.com/t_o01/items/6ad844ab04fc0170b4eb // --------------------------------------------------------------------- // --- キーワードを指定して、フォーマットしています ---- S_ReplaceAll('AND', '\r\n\tAND', 28).toUpperCase(); // 改行+TAB S_ReplaceAll('ON', '\r\n\tON', 28).toUpperCase(); // 改行+TAB S_ReplaceAll(',', '\r\n\t,', 28); // 改行・・・SELECT節が、カンマ頭で改行されることを想定 S_ReplaceAll('WHERE', '\r\nWHERE', 28).toUpperCase(); // 改行 S_ReplaceAll(';', '\r\n;', 28).toUpperCase(); // 改行 S_ReplaceAll('FROM', '\r\nFROM', 28).toUpperCase(); // 改行 S_ReplaceAll('UNION', '\r\nUNION', 28).toUpperCase(); // 改行 S_ReplaceAll('GROUP BY', '\r\nGROUP BY', 28).toUpperCase(); // 改行 S_ReplaceAll('ORDER BY', '\r\nORDER BY', 28).toUpperCase(); // 改行 S_ReplaceAll('LEFT JOIN', '\r\nLEFT JOIN', 28).toUpperCase(); // 改行 S_ReplaceAll('INNER JOIN', '\r\nINNER JOIN', 28).toUpperCase(); // 改行 // --- ここは、大文字変換のみ実行してます ---- S_ReplaceAll('SELECT', 'SELECT', 28).toUpperCase(); S_ReplaceAll('AS', 'AS', 28).toUpperCase(); S_ReplaceAll('COUNT', 'COUNT', 28).toUpperCase(); S_ReplaceAll('MAX', 'MAX', 28).toUpperCase(); S_ReplaceAll('MIN', 'MIN', 28).toUpperCase(); S_ReplaceAll('AVG', 'AVG', 28).toUpperCase(); S_ReplaceAll('CASE', 'CASE', 28).toUpperCase(); S_ReplaceAll('WHEN', 'WHEN', 28).toUpperCase(); S_ReplaceAll('THEN', 'THEN', 28).toUpperCase(); S_ReplaceAll('ELSE', 'ELSE', 28).toUpperCase(); S_ReplaceAll('END', 'END', 28).toUpperCase(); // --- 以下はコメント --- //S_ReplaceAll('\(', '\r\n\t(', 28); // カッコで改行 //S_ReplaceAll('\)', '\r\n\t)', 28); // カッコで改行 //S_ReplaceAll('OR', '\r\nOR', 28).toUpperCase(); // 改行 //S_ReplaceAll('OR', '\r\nOR', 28).toUpperCase(); // 改行 //S_ReplaceAll('AND', '\r\n AND', 28).toUpperCase(); // 改行+半角2つ //S_ReplaceAll('\( SELECT', '\r\n\( SELECT', 28).toUpperCase(); // 改行+カッコ+半角+SELECTにしている。想定は、サブクエリとか //S_ReplaceAll('\(SELECT', '\r\n\( SELECT', 28).toUpperCase(); // 改行+カッコ+半角+SELECTにしている。想定は、サブクエリとか //S_ReplaceAll('] params:', '\r\n\r\n\r\n', 28); // すべて置換 //S_ReplaceAll('?', '■', 1); // すべて置換 // 再描画 S_ReDraw(0);
vba:vlookとindex&match
vlook
Sub setVlook() On Error GoTo err: With Worksheets("sheet1") .Range("I3:I10") = WorksheetFunction.VLookup(.Range("B3:B10"), Sheet2.Range("$A$3:$B$10"), 2, False) End With Exit Sub err: Debug.Print err.Number, err.Description End Sub
index&match
Sub setIndex() On Error GoTo err: With Worksheets("sheet1") Dim i As Long For i = 3 To 10 ' index(取得したい値, match(参照元のkey, 参照先のkey)) .Range("I" & i) = WorksheetFunction.Index(Sheet2.Range("B3:B10"), WorksheetFunction.Match(.Range("A" & i), Sheet2.Range("A3:A10"), 0)) Next i End With Exit Sub err: Debug.Print err.Number, err.Description End Sub
vba:検証用ソース
- sheet1
Sub SetData() ' 画面を初期化 Rows("1:19").Select Selection.Delete Shift:=xlUp ' 列の選択状態を解除 Sheet1.Range("A1").Select ' 実行ボタンを生成 With ActiveSheet.Buttons.Add(Range("B5").Left, _ Range("B5").Top, _ Range("B5:D5").Width, _ Range("B5:D6").Height) .Name = "btn" .OnAction = "Sheet1.MakeMaxValueTable" .Characters.Text = "exe" End With ' テストデータを出力 Dim arr_id_data As Variant: arr_id_data = Array("e_01", "e_02", "e_03", "e_04", "e_05", "e_06", "e_07", "e_08", "e_09", "e_10") Dim arr_val_data As Variant: arr_val_data = Array(1000, 1300, 800, 1100, 700, 1000, 2100, 1100, 500, 800) For r = 0 To UBound(arr_id_data) Cells(r + 9, 2).Value = arr_id_data(r) Cells(r + 9, 3).Value = arr_val_data(r) Next r ' ヘッダーを設定 Sheet1.Range("B8").Value = "ID" Sheet1.Range("C8:C8").Value = "Value" Sheet1.Range("E8").Value = "閾値" ' 閾値を設定 Sheet1.Range("E9").Value = 800 ' *** 全体的な見た目の設定 **** Call SetFormat(Sheet1, Sheet1.Range("B8:C8"), "id") Call SetFormat(Sheet1, Sheet1.Range("B9:B18"), "id") Call SetFormat(Sheet1, Sheet1.Range("C9:C18"), "val") Call SetFormat(Sheet1, Sheet1.Range("E8:E8"), "id") Call SetFormat(Sheet1, Sheet1.Range("E9:E9"), "val") ' フォーカスを所定の位置へ Sheet1.Range("A1").Select End Sub ' 最大値を抽出し強調表示する Sub MakeMaxValueTable() On Error GoTo ErrHandler ' ===================== ' 開始処理 ' ===================== Dim comUtil As CommonUtil Set comUtil = New CommonUtil comUtil.ExeInit 'err.Raise 513 '画面初期化 ' 条件付き書式をクリア Dim ws As Worksheet For Each ws In Worksheets ws.Cells.FormatConditions.Delete Next ws ' グラフをクリア With Sheet1 ' 実行結果出力範囲をクリア .Rows("2:3").Clear Dim r As Long For r = .ChartObjects.Count To 1 Step -1 .ChartObjects(r).Delete Next r End With ' ===================== ' エラーチェック(EXCELSQL版) ' ' ===================== ' 'リストの値を取得して、配列に格納 ' Dim arr_ori As Variant: arr_ori = Sheet1.Range("B9:C18").Value ' ' ' 閾値を取得 ' Dim lineVal As Long: lineVal = Sheet1.Range("E9").Value ' ' ' 最大値を取得 ' Dim max_val As Long: max_val = Application.WorksheetFunction.Max(arr_ori) ' ' ' 最大値 <= 閾値は処理終了 ' If (max_val <= line_val) Then ' ' Dim rc As Integer ' ' rc = MsgBox("閾値は最大値より小さい値を設定してください。" & vbCrLf & "最大値:" & max_val, vbOKOnly + vbExclamation) ' ' If rc = vbOK Then ' Exit Sub ' End If ' ' End If ' ===================== ' DB接続(EXCELSQL版) ' ===================== ' 処理対象ファイルのフルパス ' Dim fileFullName As String: fileFullName = ThisWorkbook.FullName ' ' Dim dbUtil As DatabaseUtil ' Set dbUtil = New DatabaseUtil ' If Not dbUtil.IsConnectedDB("excelsql", fileFullName) Then ' err.Raise Number:=999, Description:="DB接続に失敗 [dbUtil.IsConnectedDB]" ' 'Debug.Print "システムエラー:DB接続に失敗しました。" ' End If ' ===================== ' DB接続(DB版) ' ===================== Dim dbUtil As DatabaseUtil Set dbUtil = New DatabaseUtil If Not dbUtil.IsConnectedDB("sqlserver", "") Then err.Raise Number:=999, Description:="DB接続に失敗 [dbUtil.IsConnectedDB]" 'Debug.Print "システムエラー:DB接続に失敗しました。" End If ' ===================== ' エラーチェック(DB版) ' ===================== Dim sqlStr As String sqlStr = "select max(line_limit) as maxLineLimit from line" 'Debug.Print sqlStr Dim rs As Recordset Set rs = dbUtil.ExeSelect(sqlStr) ' 閾値を取得(名前定義の方が、フォーマット変更に柔軟に対応できる) Dim lineVal As Long: lineVal = Sheet1.Range("lineVal").Value ' Dim lineVal As Long: lineVal = Sheet1.Range("E9").Value Dim maxLineLimit As Long: maxLineLimit = rs.Fields("maxLineLimit").Value ' Dim maxLineLimit As Long: maxLineLimit = rs.Fields.item(0) ' 最大値 <= 閾値は処理終了 If (maxLineLimit <= lineVal) Then Dim mb_1 As Integer mb_1 = MsgBox("閾値は最大値より小さい値を設定してください。" & vbCrLf & "最大値:" & maxLineLimit, vbOKOnly + vbExclamation) If mb_1 = vbOK Then Exit Sub End If End If ' ' シート名のパラメータ化が必要 ' sqlStr = "" ' sqlStr = sqlStr & " select" ' sqlStr = sqlStr & " *" ' sqlStr = sqlStr & " from" ' sqlStr = sqlStr & " [Sheet1$]" ' sqlStr = sqlStr & " where" ' sqlStr = sqlStr & " Value > " & line_val ' (EXCELSQL版) ' sqlStr = "select * from [Sheet1$] where Value > " & line_val ' (DB版) sqlStr = "select * from line where line_limit > " & lineVal Set rs = dbUtil.ExeSelect(sqlStr) ' ----------------------------------------------- ' 基本的に、ここ以降は、EXCELSQL版とDB版に違いは無し(recordsetに対しての処理なので) ' ----------------------------------------------- ' ===================== ' SQL実行結果出力 ' ===================== ' 抽出結果を出力・・・縦 ' Sheet1.Range("G2").CopyFromRecordset rs ' 抽出結果を出力・・・横 Dim fieldCnt As Long: fieldCnt = rs.Fields.Count Dim recordCnt As Long: recordCnt = rs.RecordCount ' これで、横に格納してるみたいです 'ReDim recordArray(fieldCnt, recordCnt) As Variant: recordArray = rs.GetRows 'シートに出力 ' 横に出力する場合は、起点のセルだけ指定だとうまくいかないみたいなので、出力するRangeを指定する。 'Sheet1.Range(Cells(2, 2), Cells(fieldCnt, recordCnt + 1)) = recordArray ' 抽出結果で特に何もしないなら、直接設定する方が良い Sheet1.Range(Cells(2, 2), Cells(fieldCnt, recordCnt + 1)) = rs.GetRows ' ===================== ' 最大値の設定 ' ===================== Dim fc As FormatCondition ' range・・・入れ子だと見辛いので、変数に格納 Dim resultDataRange As Range: Set resultDataRange = Sheet1.Range(Cells(3, 2), Cells(fieldCnt, recordCnt + 1)) ' 条件付き書式を生成・・・入れ子だと見辛いので、変数に格納(.Addressの絶対参照を忘れないこと) ' MAX関数は、最大値が複数ある場合は、存在するだけ最大値と判定します Dim strFormula As String: strFormula = "=B3=MAX(" & resultDataRange.Address & ")" Set fc = resultDataRange.FormatConditions.Add( _ Type:=xlExpression, _ Formula1:=strFormula) ' 最大値の見た目を設定 fc.Interior.Color = RGB(255, 0, 0) fc.Font.Color = RGB(255, 255, 255) fc.Font.Bold = True ' ===================== ' グラフを生成 ' ===================== Call MakeChart(Sheet1, fieldCnt, recordCnt, lineVal) ' ===================== ' 全体的な見た目の設定 ' ===================== Call SetFormat(Sheet1, Sheet1.Range(Cells(2, 2), Cells(2, recordCnt + 1)), "id") Call SetFormat(Sheet1, Sheet1.Range(Cells(3, 2), Cells(3, recordCnt + 1)), "val") ' フォーカスを所定の位置へ Sheet1.Range("A1").Select 'Finally:へ飛ぶ GoTo Finally ErrHandler: Dim mb_2 As Long: mb_2 = MsgBox("システムエラーが発生しました。", vbOKOnly + vbCritical) Dim logUtil As logUtil Set logUtil = New logUtil Call logUtil.OutputErrorLog(err) 'Finally:へ飛ぶ Resume Finally Finally: If Not rs Is Nothing Then rs.Close End If If Not err Is Nothing Then err.Clear End If comUtil.ExeFinal End Sub ' 書式を設定 ' 項目:id 、値:val Sub SetFormat(ByVal sh As Worksheet, ByVal rng As Range, ByVal item As String) sh.Select rng.Select With Selection ' 外枠の設定・・・ちなみにこれは、中太 '.BorderAround Weight:=xlMedium .Borders.LineStyle = True Select Case item Case "id" .HorizontalAlignment = xlCenter .Interior.Color = rgbTurquoise Case "val" .NumberFormatLocal = "#,###" End Select End With End Sub ' グラフを生成 Sub MakeChart(ByVal sh As Worksheet, ByVal fieldCnt As Long, ByVal recordCnt As Long, ByVal line_val As Long) sh.Select ' 配列に入れなおさないとうまくいかないので、入れなおす。(この辺は、要検証) Dim arr_ans() As Variant: arr_ans = Sheet1.Range(Cells(2, 2), Cells(fieldCnt, recordCnt + 1)) ' グラフ生成用に、ヘッダーと値の配列を作成 Dim arr_header As Variant: arr_header = WorksheetFunction.Transpose(WorksheetFunction.Index(arr_ans, 1, 0)) Dim arr_val As Variant: arr_val = WorksheetFunction.Transpose(WorksheetFunction.Index(arr_ans, 2, 0)) Dim co As ChartObject ' グラフの外枠?を設置 Set co = ActiveSheet.ChartObjects.Add(Left:=Range("G8").Left, Top:=Range("G8").Top, Width:=324, Height:=206) ' グラフの中身を生成 With co With .Chart.SeriesCollection.NewSeries .Name = "Value" .Values = arr_val .XValues = arr_header End With End With With co.Chart 'グラフ形式を設定 co.Chart.ChartType = xlColumnClustered '凡例非表示 co.Chart.HasLegend = True ' グラフの左線を強調(線の太さと色・・・結構見やすいかも) .Axes(xlValue).format.Line.Weight = 2 .Axes(xlValue).format.Line.ForeColor.RGB = RGB(0, 0, 0) ' グラフの下線を強調 .Axes(xlCategory).format.Line.Weight = 2 .Axes(xlCategory).format.Line.ForeColor.RGB = RGB(0, 0, 0) '基準線を新規系列として追加 With .SeriesCollection.NewSeries .Name = "=""閾値""" '特に必要はない .Values = "={" & Join(Array(line_val, line_val), ",") & "}" .ChartType = xlLine '折れ線 .AxisGroup = 2 '第2軸 .format.Line.ForeColor.RGB = vbRed 'RGB(255, 0, 0) End With '第2縦軸のScaleを第1縦軸に合わせる .Axes(xlValue, 2).MinimumScale = .Axes(xlValue, 1).MinimumScale .Axes(xlValue, 2).MaximumScale = .Axes(xlValue, 1).MaximumScale .Axes(xlValue, 2).Delete '第2軸を消す 'グラフ内左右余白を消す:基準線を第2横軸に設定 .HasAxis(xlCategory, 2) = True '第2横軸表示 .Axes(xlCategory, 2).AxisBetweenCategories = False '軸位置を目盛 .Axes(xlCategory, 2).TickLabelPosition = xlNone '目盛ラベルなし End With End Sub
- CommonUtil
Option Explicit Public Sub ExeInit() With ActiveWorkbook.Application .Calculation = xlCalculationManual .ScreenUpdating = False .EnableEvents = False End With End Sub Public Sub ExeFinal() With ActiveWorkbook.Application .Calculation = xlCalculationAutomatic .ScreenUpdating = True .EnableEvents = True End With End Sub Public Function ConvertDateToString(ByVal dt As Date, ByVal formatNo As Long) As String Select Case formatNo Case 1 ConvertDateToString = format(dt, "yyyymmdd") ' 20210620 Case 2 ConvertDateToString = format(Now, "ggge年m月d日") ' 令和3年6月20日 Case 3 ConvertDateToString = format(Now, "aaaa") ' 日曜日 Case 4 ConvertDateToString = format(Now, "Long Date") ' 2021年6月20日 Case 5 ConvertDateToString = format(Now, "Medium Date") ' 21-06-20 Case 6 ConvertDateToString = format(Now, "Short Date") ' 2021/06/20 Case 7 ConvertDateToString = format(Now, "Long Time") ' 3:06:59 Case 8 ConvertDateToString = format(Now, "Medium Time") ' 03:07 午前 Case 9 ConvertDateToString = format(Now, "Short Time") ' 03:07 End Select End Function Public Function ConvertNumberFormat(ByVal num As Long, ByVal formatNo As Long) As String Select Case formatNo Case 1 ConvertNumberFormat = format(num, "General Number") ' 10000 --> 10000 Case 2 ConvertNumberFormat = format(num, "Currency") ' 10000 --> \10,000 Case 3 ConvertNumberFormat = format(num, "Fixed") ' 1235.678 -- > 1235.68 Case 4 ConvertNumberFormat = format(num, "Standard") ' 1235.678 --> 1,235.68 Case 5 ConvertNumberFormat = format(num, "Percent") ' 0.123456 --> 12.35% End Select End Function
- DatabaseUtil
Option Explicit Private cn As ADODB.Connection Private rs As ADODB.Recordset '------------------------------------------------------------------------------------- ' コンストラクタ '------------------------------------------------------------------------------------- Private Sub class_initialize() If Not rs Is Nothing Then rs.Close End Sub '------------------------------------------------------------------------------------- ' デストラクタ '------------------------------------------------------------------------------------- Private Sub class_terminate() On Error Resume Next If Not rs Is Nothing Then rs.Close Set rs = Nothing cn.Close Set cn = Nothing End Sub '------------------------------------------------------------------------------------- ' データベース接続 '【引数】DBType 接続するDBを指定 ' excelsql … Excelをデータベースとして接続 ' sqlserver … SQLSERVERをデータベースとして接続 '【戻値】接続成功:True / 接続失敗:False(Boolean) '------------------------------------------------------------------------------------- Public Function IsConnectedDB(ByVal useDb As String, ByVal fileFullName As String) As Boolean Dim ConnectingString As String Select Case useDb Case "excelsql" ConnectingString = "PROVIDER = MSDASQL; Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)}; " & "DBQ=" & fileFullName & "; ReadOnly=False;" Case "sqlserver" '=============================== '接続文字列 '=============================== 'プロバイダ Const PROVIDER As String = "MSOLEDBSQL" 'サーバー名(サーバーのPC名\インスタンス名) Const SERVER_NAME As String = "test\test" 'DB名 Const DB_NAME As String = "test" '=============================== 'SQL Serverへ接続 '=============================== '接続文字列の組み立て ConnectingString = "Provider=" & PROVIDER & ";" & _ "Data Source='" & SERVER_NAME & "';" & _ "Initial Catalog='" & DB_NAME & "';" & _ "Integrated Security=SSPI;" & _ "DataTypeCompatibility=80;" Case Else GoTo ErrHandler End Select On Error GoTo ErrHandler Set cn = New ADODB.Connection cn.ConnectionString = ConnectingString cn.ConnectionTimeout = 2 cn.Open IsConnectedDB = True Exit Function ErrHandler: IsConnectedDB = False End Function '------------------------------------------------------------------------------------- ' SQL文を実行する(Select 文) '【引数】strSQL SQL文 '【戻値】Recordset オブジェクト '------------------------------------------------------------------------------------- Public Function ExeSelect(ByVal strSQL As String) As ADODB.Recordset Set rs = New ADODB.Recordset 'SQL文実行(読み取り専用、共有ロック) rs.Open strSQL, cn, adOpenKeyset, adLockOptimistic, adCmdText Set ExeSelect = rs End Function '------------------------------------------------------------------------------------- ' SQL文を実行する(Insert into文、Delete 文など) '【引数】strSQL SQL文(String) '【戻値】変更されたレコード数(Long) '------------------------------------------------------------------------------------- Public Function ExeUpdate(strSQL As String) As Long Dim updateCnt As Long cn.Execute strSQL, updateCnt ExeUpdate = updateCnt End Function '------------------------------------------------------------------------------------- 'トランザクション開始 '------------------------------------------------------------------------------------- Public Sub BeginTr() cn.BeginTrans End Sub '------------------------------------------------------------------------------------- ' トランザクションコミット '------------------------------------------------------------------------------------- Public Sub CommitTr() cn.CommitTrans End Sub '------------------------------------------------------------------------------------- ' トランザクションロールバック '------------------------------------------------------------------------------------- Public Sub RollbackTr() cn.RollbackTrans End Sub
- LogUtil
Option Explicit '----------------------------------------------------- ' エラーログをファイルに出力する ' 出力先は、実行ファイルと同様のフォルダ、出力先のフォルダが無い場合は、生成する。 ' 出力ファイ名:yyyymmdd_error.log ※日付は、出力当日 ' ' 引数:エラーオブジェクト ' '----------------------------------------------------- Public Sub OutputErrorLog(ByVal err As ErrObject) Dim comUtil As CommonUtil Set comUtil = New CommonUtil ' ファイル名から拡張子を削除→フォルダ名 Dim logFolderName As String: logFolderName = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5) ' 実行当日からファイル用の日付を抽出し、ファイル名を生成 Dim logFileName As String: logFileName = comUtil.ConvertDateToString(Now, 1) & "_error.log" Dim folderPath As String: folderPath = ThisWorkbook.Path & "\" & logFolderName Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") ' フォルダが無い場合、生成 If Dir(folderPath, vbDirectory) = "" Then fso.CreateFolder (folderPath) Dim strPath As String: strPath = ThisWorkbook.Path & "\" & logFolderName & "\" & logFileName Dim logMsg As String: logMsg = Now & vbTab & "NO:" & err.Number & vbTab & "DESC:" & err.Description ' エラー内容を出力 With fso If Not .FileExists(strPath) Then .CreateTextFile (strPath) End If With .OpenTextFile(strPath, 8) .WriteLine logMsg .Close End With End With Set fso = Nothing End Sub
vba:Recordset:SQLで最大値を取得して、Recordsetから取り出す
- 多分、カラム名を指定しての方が良い気がする。
Dim sqlStr As String sqlStr = "select max(line_limit) as maxLineLimit from line" 'Debug.Print sqlStr Dim rs As Recordset Set rs = dbUtil.ExeSelect(sqlStr) ' 最大値を取得 ' Dim maxLineLimit As Long: maxLineLimit = rs.Fields("maxLineLimit").Value Dim maxLineLimit As Long: maxLineLimit = rs.Fields.item(0) ' 最大値 <= 閾値は処理終了 If (maxLineLimit <= line_val) Then Dim rc As Integer rc = MsgBox("閾値は最大値より小さい値を設定してください。" & vbCrLf & "最大値:" & maxLineLimit, vbOKOnly + vbExclamation) If rc = vbOK Then Exit Sub End If End If
vba:format
こちらのサイトが見やすい!
Public Function ConvertNumberFormat(ByVal num As Long, ByVal formatNo As Long) As String Select Case formatNo Case 1 ConvertNumberFormat = format(num, "General Number") ' 10000 --> 10000 Case 2 ConvertNumberFormat = format(num, "Currency") ' 10000 --> \10,000 Case 3 ConvertNumberFormat = format(num, "Fixed") ' 1235.678 -- > 1235.68 Case 4 ConvertNumberFormat = format(num, "Standard") ' 1235.678 --> 1,235.68 Case 5 ConvertNumberFormat = format(num, "Percent") ' 0.123456 --> 12.35% End Select End Function