饂飩コーディング

iOSアプリやら、Unityやら、Cocos2dやらごにょごにょ書いております

非連結のフォームを使おう。連結フォーム?そりゃ使っちゃだめだよ。

はい!タイトルはさておき、連結フォームは危険。いみわかんないw
Accessってなんだかなぁ~と思う今日この頃。

てなわけで非連結フォームの導入部分の記述をします。

いくつかやり方はあるらしいんだけど、
詳細部分あるボタンをクリックして
そのボタンから明細フォームを開くときに引数でキーを渡して
明細フォームではそのキーでSQL文発行して
各コンボボックスにデータをセットしするって感じです。

下の帳票フォーム部分の左にある小さなボタンを押して、明細用のフォームを引数IDを渡して
開きます。
f:id:appdeappuappu:20201227214242p:plain

Private Sub コマンド36_Click()
    DoCmd.OpenForm "フォーム6", , , , , , Me.ID
End Sub


ボタンをおしたらこんな画面が開く。
f:id:appdeappuappu:20201227214431p:plain

フォームの読込イベントに以下の感じでSQLで入れてあげれば簡単。

Private Sub Form_Load()
    Me.txtID = OpenArgs
    
    Dim myCn     As ADODB.Connection    'ADOコネクションオブジェクト
    Dim myRs     As ADODB.Recordset     'ADOレコードセットオブジェクト
    Dim strSQL   As String              'SQL文用文字列
    
    '現在のデータベースへ接続
    Set myCn = CurrentProject.Connection
    
    'ADOレコードセットのインスタンス作成
    Set myRs = New ADODB.Recordset
    
    myRs.CursorLocation = adUseClient
    'SQL文
    strSQL = "SELECT 商品マスター.ID, 商品マスター.商品番号, 商品マスター.大分類, 商品マスター.中分類, 商品マスター.小分類, 商品マスター.商品名, 商品マスター.商品説明1, 商品マスター.商品説明2"
    strSQL = strSQL & " FROM 商品マスター"
    strSQL = strSQL & " WHERE ID =  " & OpenArgs & ""
    strSQL = strSQL & " ;"
    
    'レコードセット取得・・・(※1)
    myRs.Open strSQL, myCn, adOpenKeyset, adLockReadOnly
    myRs.MoveFirst
    
        Me.cbItem = myRs.Fields("商品番号")
        Me.cbDai = myRs.Fields("大分類")
        Me.cbCyuu = myRs.Fields("中分類")
        Me.cbSyou = myRs.Fields("小分類")
    
    'オブジェクトの開放
    Set myRs = Nothing: Close
    Set myCn = Nothing: Close
End Sub

あとは、ボタンをつけて、更新処理なり削除処理なり、何なりと実装しましょう。

個人的には連結フォームはどんな場面で使うのか思いつきません。
自分だけが使う画面ならいいけどその程度かなぁ・・・

Accessに明るい人は、連結フォーム使いがちだけど
自分は連結フォーム怖くてドキドキしちゃいます。ほぼ勝手にデータ更新しちゃうしねぇ~

テキストボックスの文字色がVBAで変更できない!!!それは使用可能・編集ロックのせい

参考になったサイト様 感謝!
www.relief.jp

こちらにサイトに掲載されている
一覧表がとても参考になりました。





f:id:appdeappuappu:20201218225617p:plain

テキストボックスの使用可能、編集ロックの組み合わせは
それぞれ二種類で合計四種類。

それぞれ設定した四つのテキストボックスに
それぞれ前景色を赤にするVBAを記述してみましたが

使用可能 いいえ
編集ロック いいえ

のテキストボックスだけ色が変わりません。
そういうものらしいです。

もし
マウスクリックしたときに、入力中を示す|を表示させたくない
だけれども、VBAで文字の色を変更したい場合。は

使用可能 いいえ
編集ロック はい

にすればOKです。VBAで色を変えることができます。


使い方としては
はい-はい     レコード項目表示用のテキストボックスで編集させたくないけどコピー用途がある場合
はい-いいえ    データの入力用 文字入力可能な設定です
いいえ-はい    純粋な表示だけの設定 文字カーソル|も入りません。
いいえ-いいえ   全体がグレーアウトします。VBAでのコントロールも制限されてます。(色はVBAから変更不可でした)


以下はマイクロソフトの説明ですが、使用可能プロパティーについてが自分いはいまいち
しっくりきませんでした。
使用可能プロパティの説明
support.microsoft.com


編集ロックプロパティの説明
support.microsoft.com

SQLでカウントしてそのまま表示するだけ

f:id:appdeappuappu:20201217212804p:plain
f:id:appdeappuappu:20201217213651p:plain

コンボボックスで商品マスターの大分類、中分類、小分類でデータを絞り込んで
そのレコード数をSQLでカウントするだけの例です。

目的はデータを絞り込んだレコード数を知りたいだけなので、
効率的なやり方は他にあるとおもいますが、あえてSQL使ってやってみました。

ポイントは
VBASQLでlikeするときは”%”を使うところ。
クエリでは”*”がワイルドカードだけどVBAだとちがうんですね~

他のやり方としては、表示しているサブフォームのレコードセットのカウントプロパティ
を取得する方法かなぁ・・・

Private Sub cmd計算_Click()

    Dim myCn     As ADODB.Connection    'ADOコネクションオブジェクト
    Dim myRs     As ADODB.Recordset     'ADOレコードセットオブジェクト
    Dim strSQL   As String              'SQL文用文字列
    
    
    '現在のデータベースへ接続
    Set myCn = CurrentProject.Connection
    
    'ADOレコードセットのインスタンス作成
    Set myRs = New ADODB.Recordset
    
    myRs.CursorLocation = adUseClient
    
    Dim stringDai As String
    Dim stringCyuu As String
    Dim stringSyou As String
    
    Dim recordCount As Integer
    
    If IsNull(Me.cb大分類) Then
        stringDai = "%"
    Else
        stringDai = Me.cb大分類
    End If
    
    If IsNull(Me.cb中分類) Then
        stringCyuu = "%"
    Else
        stringCyuu = Me.cb中分類
    End If
    
    If IsNull(Me.cb小分類) Then
        stringSyou = "%"
    Else
        stringSyou = Me.cb小分類
    End If
    
    
    
    'SQL文
    strSQL = "SELECT Count(商品マスター.ID) as カウント数"
    strSQL = strSQL & " FROM 商品マスター"
    strSQL = strSQL & " WHERE 大分類 LIKE '" & stringDai & "' AND"
    strSQL = strSQL & " 中分類 LIKE '" & stringCyuu & "' AND"
    strSQL = strSQL & " 小分類 LIKE '" & stringSyou & "'"
    strSQL = strSQL & " ;"
    
    'レコードセット取得・・・(※1)
    myRs.Open strSQL, myCn, adOpenKeyset, adLockReadOnly
  
    myRs.MoveFirst
    
    
        recordCount = myRs.Fields("カウント数")
    
  
    MsgBox "選択したレコードすうは!" & recordCount, vbOKOnly + vbInformation
    

    'オブジェクトの開放
    Set myRs = Nothing: Close
    Set myCn = Nothing: Close

End Sub

レコード選択画面を作成してみる 少しましバージョン

さて、レコード選択画面を作成してみるダメバージョンの記事ではコンボボックスで選択するテーブル項目にNullがはいっていると期待していたレコード選択ができませんでした。

そこで!!今回は違う方法でレコード選択してみましょう。

手順1,Nullが存在しているテーブルカラムは一度Nullチェックして空白文字にいったん置き換える。
手順2,空白文字に置き換えたら、クエリのLIKEで拾っていく。

こういう手筈です。なぜこうしたかというと、Nullだと文字数0だし検索にもヒットしないから。LIKEで拾ってこられない!!!

実装方法
手順1の実装
 f:id:appdeappuappu:20201203222115p:plain
小分類にはNullが含まれています。そこで表示する商品マスターの小分類にはQueryの選択条件を入れず代わりに、NZ(小分類,'')でクエリにフィールドを新たに作ります。この新規フィールドは非表示にしておきこの追加したフィールドの選択条件を以下の様にします。

手順2の実装
Like IIf(Nz([Forms]![フォーム2]![cb小分類],'')='',"*",[Forms]![フォーム2]![cb小分類])で拾うってかんじです。

意味としては、NZ(小分類,'')でテーブルの小分類にNullがセットされていたら空文字にしておき
Like IIf(Nz([Forms]![フォーム2]![cb小分類],'')='',"*",[Forms]![フォーム2]![cb小分類])で
選択用のコンボボックスがNullだったら*で置き換えてからLIKEで拾っていく。
選択用のコンボボックスがNullでなければ、コンボボックスの内容でデータをLIKEで拾っていく。
という感じです。

商品説明1,商品説明2にもNullが含まれていますがこちらも同じ手順で対応可能です。


is Nullが商品説明1、商品説明2にセットされていますが、これは上記の対応ではないので
無視してください。

商品説明1,商品説明2がともにNullの場合のみ選択するチェックボックス
機能させる場合は、チェックボックスの条件付けをおこなってあげて下のように設定すればOK
f:id:appdeappuappu:20201203225152p:plain


検索フォームでの見た目はこんな感じ
f:id:appdeappuappu:20201203225738p:plain


すべてのチェックボックスが機能しました。

フォームのレコードソースをExcelで出力する。

「Accessのフォームから、データをかんたんにExcelに出力する方法」~VBAで関数にしちゃいましょ♪~ |


AccessからVBAでEXCELへ帳票出力する|アズビーパートナーズ




参考にさせていただきました。

'Excelにデータを出力
Function ExcelData(frm As Form)
    On Error GoTo Err_cmdExcel_Click

    'DAOで抽出結果のクローンを作成
    Dim xls As Object 'Excel.Applicationを代入するオブジェクト変数
    Dim wkb As Object 'Excel.Wookbookを代入するオブジェクト変数
    Dim rst As DAO.Recordset '現在のレコードセットを入れる変数
    Dim idx As Long  'フィールド数変数

    Set rst = Nothing 'データリストの初期化
    Set rst = frm.RecordsetClone  'フォームのレコードセットのクローンを代入

    'レコードが存在しない場合、処理を中止
    If rst.BOF = True And rst.EOF = True Then
        MsgBox "出力出来るデータがありません。", vbOKOnly + vbExclamation, "出力不可"
        'レコードセットを閉じる
        rst.Close: Set rst = Nothing
        Exit Function
    End If

    'レコードが存在する場合、Excelに出力
    'レコードセットの最初のデータにカーソルを移動
    rst.MoveFirst

    'Excelファイルを内部的に作成
    Set xls = CreateObject("Excel.Application")
    '作成されたExcelファイルにワークブックを追加
    Set wkb = xls.Workbooks.Add()
    'Worksheets(1).Name = "売上データ"
    wkb.Worksheets(1).Name = "マスタ"

    '追加されたワークブックに、レコードセットのデータをコピー
    With wkb.Worksheets(1)
        For idx = 1 To rst.Fields.Count
            .Cells(1, idx).Value = rst.Fields(idx - 1).Name
        Next
        .Range("A2").CopyFromRecordset Data:=rst
        .columns(rst.Fields.Count).Delete '最終列の削除をする場合はこの行で削除する。
    End With
    
    
    'ファイル名作成
    Dim strFileName     As String
    strFileName = "sample3" & "_" & Format(Date, "yyyymmdd") & ".xlsx"
    '完了したら保存
    xls.ActiveWorkBook.SaveAs FileName:=strFileName
       

    'レコードセットを閉じる
    rst.Close: Set rst = Nothing
    'Excelデータを表示
    
'    xls.Visible = True
'    xls.UserControl = True
    
    xls.Visible = False
    xls.UserControl = False
    
    
    'メモリに展開されたExcel用オブジェクト変数を開放
    Set wkb = Nothing
    Set xls = Nothing

Exit_cmdExcel_Click:
    Exit Function

Err_cmdExcel_Click:
    'エラーの場合、エラーNOと内容を表示
'    MsgBox Err.Number & Err.Description
    MsgBox "エラーのため、Excelへ出力できません。" & vbCrLf & "一旦フォームを閉じ、再度トライしてください。", _
    vbOKOnly + vbCritical, "Excel出力不可!"
    Resume Exit_cmdExcel_Click
End Function


呼び出し側

Private Sub cmdExcel_Click()
    'Meは、このフォームという意味
    Call ExcelData(Me)

    '(forms!Form商品一覧というように、ここにフォーム名を指定してもOK!)
    'Call ExcelData(Forms!商品一覧)
End Sub