～ kiku tips ～　表示＝入力なの？

スポンサーサイト

上記の広告は１ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

--/--/--

TB： -- / CM： --

表示したら、その画面（フォーム）のまま入力したい。･･･ってどうなのでしょう？
特に表示したものは、複数のテーブルから構成されており････
安易（容易）に入力できるものだろうか･･･???

私は結構割り切ってます。
表示は表示････入力は入力･･･

入力する時には、１フォーム･･･基本１テーブルと考えてます。
テーブルがリレーションイシップメージで段々になっているのなら、
個々をサブフォームとして表現するようにしています。

なぜなら、表示は更新する必要が無いので、クエリを作るにしても更新できる/できない･･･
を考える必要が無い。。。。
入力が絡むと、１フォーム１テーブルで考えた方が間違いない･･･とも。

ここで、以下のようなテーブルがあり、リレーションシップが設定されているとします。

この時、一連の設定状況を見ながら入力/更新していくには････
（上の段と、下の段は同じものです。後述する処理で単に別物としただけです）

ここでは、表示にリストボックスを用いて、
入力用には個々のテーブルに対応したサブフォームを使ってみることにします。
また、サブフォームに表示する元々のフォームを１つにしてみました。

サブフォームとして組み込む時、１つのフォームを複数のサブフォームに指定することが出来ます。
が、注意事項として、
例えば、コマンドボタンの Visible を変更すると、他のサブフォーム表示にも影響する･･･
これを考えないといけません。
（帳票フォームの詳細にコマンドボタンを配置した時に、個別に制御できない、それと同じです）

上記テーブル構成を考えた時、以下のようなフォームを考えてみました。

で、サブフォーム部分は右側４段ですが、そこに使っているのは

で、どのテーブルに対して････固定情報は持たないようにしました。

サブフォーム「FS1」の作成

フォームデザインで作成していきます。
単票としてシンプルに作っていきます。
各テーブルに共通して入力しないといけない部分を可視で作成していきます。
「txt1」として、日付部分、「txt2」として、内容の入力部分（T受付では担当者として）
非表示部分として、各テーブルに必要なものを作っておきます。
フィールド「use」用に、オプションボタン「op11」
自分のID用に「txt11」
親のID用に「txt12」

サブフォームになっているっていう事は、
単にフォームを起動する時のように WhereCondition を指定できるでもないし、OpenArg を渡せるでもない。
そこで、サブフォームとして設定する前に、親の Tag に必要な情報を設定しておき、
その後で、サブフォームコントロールのソースオブジェストにサブフォームを設定することで、
Open イベント時に、親の Tag を参照させ必要な情報を入手するようにしました。

この時、例えば、親の Tag に
"2,T見積,見積日付,見積内容,見積ID,受付ID"　とあれば、
私は２番
対象のテーブルは「T見積」
「txt1」は、「見積日付」に連結
「txt2」は、「見積内容」に連結
で、自分のIDは「見積ID」で、「txt11」に連結
また、親のIDは、「受付ID」で、「txt12」に連結
ってな具合で、情報を Tag 経由で通知します。

その後、子と親でやり取りしますが、私は「 X 番」を使って行います。
オプションボタンは、そのレコードが有効/無効の意味を持つ「use」と連結しておきます。
（ただし、「F1」「FS1」のパターン時には使用していません）

フォーム「FS1」は単票フォームとして作成しておきます。
「レコードセレクタ」「移動ボタン」は「いいえ」

基本的には、この「FS1」のOpen 時に、自分は何を表示するのか････
親とやり取りしながら Filter を設定します。
設定する Filter が無ければ、データ入力用に設定します。
単票で、移動ボタンが無いので、現レコードと新規の切り替えは「Page Up」「Page Down」で切り分けます。
で、どの状況にあるか表示しておきます。
テキストボックス「ts1」のコントロールソースに　=IIf([DataEntry] Or [NewRecord],"新規","更新")
さらに、条件付き書式で　フィールドの値が "新規" なら「赤で斜体」に･･･
また、いじれない様に「編集ロック」を「はい」、「使用可能」を「いいえ」に
記述したVBAは

Dim myNo As Integer
Dim bNewEdit As Boolean

Private Sub Form_Open(Cancel As Integer)
　　Dim sAry() As String

　　On Error Resume Next
　　sAry = Split(Me.Parent.Tag, ",")
　　If (Err <> 0) Then
　　　　Cancel = True
　　　　Exit Sub
　　End If

　　myNo = CInt(sAry(0))
　　Me.RecordSource = sAry(1)
　　Me.txt1.ControlSource = sAry(2)
　　Me.txt1.Controls(0).Caption = sAry(2)
　　Me.txt2.ControlSource = sAry(3)
　　Me.txt2.Controls(0).Caption = sAry(3)
　　Me.op11.ControlSource = "use"
　　Me.txt11.ControlSource = sAry(4)
　　Me.txt12.ControlSource = sAry(5)

　　Me.Filter = Me.Parent.GetMyFilter(myNo)
　　Me.FilterOn = Len(Me.Filter) > 0
　　If (Not Me.FilterOn) Then
　　　　Me.DataEntry = True
　　End If
　　bNewEdit = False
End Sub

Private Sub Form_Current()
　　If (bNewEdit) Then Call Me.Parent.ReShow(myNo)
　　bNewEdit = False
End Sub

Private Sub Form_BeforeInsert(Cancel As Integer)
　　Call Me.Parent.NewMyItemReset(myNo)
　　bNewEdit = True
End Sub

Private Sub Form_BeforeUpdate(Cancel As Integer)
　　If (Me.NewRecord) Then
　　　　Me.txt11 = Nz(DMax(Me.txt11.ControlSource, Me.RecordSource), 0) + 1
　　　　If (Len(Me.txt12.ControlSource) > 0) Then
　　　　　　Me.txt12 = Me.Parent.GetMyParentItem(myNo)
　　　　End If
　　End If
End Sub

Private Sub Form_AfterUpdate()
　　Call Me.Parent.NewMyItemSet(myNo, Me.txt11)
　　bNewEdit = False
End Sub

親フォーム「F1」の作成

親はフォームデザインで作成していきます。
単票として、「レコードセレクタ」「移動ボタン」は「いいえ」にしておきます。
４つのテーブルを簡易に表示するものとしてリストボックス「lst1」を作っておきます。
値集合ソースは、入力しないので表示できれば良いもので作ります。

SELECT
IdMake(T1.受付ID,T2.見積ID,T3.契約ID,T4.完了ID) AS ID,
T1.受付ID,
T1.受付日付,
T2.見積ID,
T2.見積日付,
T3.契約ID,
T3.契約日付,
T4.完了ID,
T4.完了日付,
Switch(IsNull(T1.受付日付),0,IsNull(T2.見積日付),1,IsNull(T3.契約日付),2,IsNull(T4.完了日付),3,True,4) AS 判定
FROM
(((SELECT * FROM T受付 WHERE use=True) AS T1
LEFT JOIN
(SELECT * FROM T見積 WHERE use=True) AS T2 ON T1.受付ID=T2.受付ID)
LEFT JOIN (SELECT * FROM T契約 WHERE use=True) AS T3 ON T2.見積ID=T3.見積ID)
LEFT JOIN (SELECT * FROM T完了 WHERE use=True) AS T4 ON T3.契約ID=T4.契約ID
ORDER BY IdMake(T1.受付ID,T2.見積ID,T3.契約ID,T4.完了ID) DESC;

列数は　10
列幅は　0cm;0cm;2.503cm;0cm;2.503cm;0cm;2.503cm;0cm;2.503cm;1cm
（日付部分のみが表示されるように）
IdMake はユーザ定義関数として、標準モジュールに記述したもので、
一覧にした時に、そのレコードを１意に特定するための文字列を作るもので

Public Function IdMake(ParamArray vAry()) As String
　　Dim i As Integer
　　Dim sS As String
　　Dim sTmp As String

　　sS = ""
　　For i = LBound(vAry) To UBound(vAry)
　　　　sTmp = Nz(vAry(i))
　　　　If (Len(sTmp) = 0) Then sTmp = "Z"
　　　　sS = sS & "-" & sTmp
　　Next
　　IdMake = Mid(sS, 2)
End Function

各テーブルの「xxxID」を連結して作成しています。

リストボックスの上には、各テーブルでの「ID」を格納しておくテキストボックスを配置。
リストボックスがクリックされた時点で、テキストボックスに値を設定します。
が、テーブル上 Null の値は、リストボックス上では "" になるため、
テキストボックスの何もない状態は "" になります。
（この辺、注意！！）

で、各状態をサブフォームとやり取りする関数を Public 宣言しておきます。
やり取りの主は、サブフォームごとに割り付けた「番号」を使って行います。

VBAで記述したものは以下

Dim CSUB(1 To 4) As Variant

Private Sub initCnst()
　　CSUB(1) = Array("txt1", "受付ID", "1,T受付,受付日付,担当者,受付ID,")
　　CSUB(2) = Array("txt2", "見積ID", "2,T見積,見積日付,見積内容,見積ID,受付ID")
　　CSUB(3) = Array("txt3", "契約ID", "3,T契約,契約日付,契約内容,契約ID,見積ID")
　　CSUB(4) = Array("txt4", "完了ID", "4,T完了,完了日付,完了内容,完了ID,契約ID")
End Sub

Public Function GetMyFilter(iNum As Integer) As String
　　Dim s As String

　　GetMyFilter = ""
　　s = Me(CSUB(iNum)(0))
　　If (Len(s) > 0) Then
　　　　GetMyFilter = CSUB(iNum)(1) & " = " & s
　　End If
End Function

Public Function GetMyParentItem(iNum As Integer) As Long
　　Dim i As Integer
　　Dim s As String

　　GetMyParentItem = 0
　　i = iNum - 1
　　If (i > 0) Then
　　　　s = Me(CSUB(i)(0))
　　　　If (Len(s) = 0) Then
　　　　　　GetMyParentItem = 0
　　　　Else
　　　　　　GetMyParentItem = CLng(s)
　　　　End If
　　End If
End Function

Public Sub NewMyItemReset(iNum As Integer)
　　Dim i As Integer

　　If (Len(Me(CSUB(iNum)(0))) = 0) Then Exit Sub

　　DoCmd.Echo False
　　For i = iNum To 4
　　　　Me("txt" & i) = ""
　　Next
　　For i = iNum + 1 To 4
　　　　With Me("FSUB" & i)
　　　　　　.Visible = False
　　　　　　.SourceObject = ""
　　　　End With
　　Next
　　DoCmd.Echo True
End Sub

Public Sub NewMyItemSet(iNum As Integer, iSrc As Long)
　　Dim sTxt As String

　　DoCmd.Echo False
　　sTxt = CSUB(iNum)(0)
　　If (Me(sTxt) <> iSrc) Then
　　　　Me(sTxt) = iSrc
　　　　Me.lst1 = IdMake(Me.txt1.Value, Me.txt2.Value, Me.txt3.Value, Me.txt4.Value)
　　End If
　　Me.lst1.Requery
　　Call ShowFSub(iNum)
　　With Me("FSUB" & Choose(iNum, 2, 3, 4, 1))
　　　　.SetFocus
　　　　.Form.txt1.SetFocus
　　End With
　　DoCmd.Echo True
End Sub

Public Sub ReShow(iNum As Integer)
　　DoCmd.Echo False
　　Call lst1_Click
　　With Me("FSUB" & iNum)
　　　　.SetFocus
　　　　.Form.txt1.SetFocus
　　End With
　　DoCmd.Echo True
End Sub

Private Sub ShowFSub(iNum As Integer)
　　Dim i As Integer
　　Dim bShow As Boolean

　　bShow = True
　　For i = iNum To 4
　　　　With Me("FSUB" & i)
　　　　　　If (bShow) Then
　　　　　　　　Me.Tag = CSUB(i)(2)
　　　　　　　　.SourceObject = "FS1"
　　　　　　　　.Visible = True
　　　　　　　　If (Len(Me(CSUB(i)(0))) = 0) Then bShow = False
　　　　　　Else
　　　　　　　　.Visible = False
　　　　　　　　.SourceObject = ""
　　　　　　End If
　　　　End With
　　Next
　　Me.Tag = ""
End Sub

Private Sub init()
　　Dim i As Integer

　　Me.lst1 = Null
　　Me.lst1.Requery

　　For i = 1 To 4
　　　　Me("txt" & i) = ""
　　　　With Me("FSUB" & i)
　　　　　　.Visible = False
　　　　　　.SourceObject = ""
　　　　End With
　　Next
End Sub

Private Sub Form_Load()
　　Call initCnst
　　Call init
End Sub

Private Sub lst1_Click()
　　DoCmd.Echo False
　　Me.txt1 = Me.lst1.Column(1)
　　Me.txt2 = Me.lst1.Column(3)
　　Me.txt3 = Me.lst1.Column(5)
　　Me.txt4 = Me.lst1.Column(7)
　　Call ShowFSub(1)
　　DoCmd.Echo True
End Sub

Private Sub btn1_Click()
　　DoCmd.Echo False
　　Call init
　　DoCmd.Echo True
End Sub

Private Sub btn2_Click()
　　DoCmd.Echo False
　　Call init
　　Me.Tag = CSUB(1)(2)
　　With Me("FSUB1")
　　　　.SourceObject = "FS1"
　　　　.Visible = True
　　　　.SetFocus
　　　　.Form.txt1.SetFocus
　　End With
　　Me.Tag = ""
　　DoCmd.Echo True
End Sub

これで、大体の動きはわかるかな････と思います。

ただ、各テーブルに設けていた「use」（このレコードは有効/無効）を使っていないので、
途中でレコードを新規作成しても、前のデータはそのまま残っていったと思います。

ということで、途中新規作成したら、今までのものは無効とするうごきのもの･･･
フォーム「F2」と「FS2」の組み合わせ････

を次に･･･

途中で新規を作成したら、その時点（そのテーブル）の「use」を変更します。
変更することで、それ以降下のものは現れないようになります。
（リストボックスの表示で「use」を見て抽出するようにしていたから･･･）

データ（レコード）自体は削除していないので、メンテナンス時点にでも削除してみるとか･･･

「F1」「F2」での動きの違いを感じられたらと････

なお、「F1」は上の段のテーブル群を、「F2」は下の段のテーブル群を使っています。
（各テーブルの構成は同じです）

「FS2」のVBA

Dim myNo As Integer
Dim bNewEdit As Boolean

Private Sub Form_Open(Cancel As Integer)
　　Dim sAry() As String

　　On Error Resume Next
　　sAry = Split(Me.Parent.Tag, ",")
　　If (Err <> 0) Then
　　　　Cancel = True
　　　　Exit Sub
　　End If

　　myNo = CInt(sAry(0))
　　Me.RecordSource = sAry(1)
　　Me.txt1.ControlSource = sAry(2)
　　Me.txt1.Controls(0).Caption = sAry(2)
　　Me.txt2.ControlSource = sAry(3)
　　Me.txt2.Controls(0).Caption = sAry(3)
　　Me.op11.ControlSource = "use"
　　Me.txt11.ControlSource = sAry(4)
　　Me.txt12.ControlSource = sAry(5)

　　Me.Filter = Me.Parent.GetMyFilter(myNo)
　　Me.FilterOn = Len(Me.Filter) > 0
　　If (Not Me.FilterOn) Then
　　　　Me.DataEntry = True
　　End If
　　bNewEdit = False
End Sub

Private Sub Form_Current()
　　If (bNewEdit) Then Call Me.Parent.ReShow(myNo)
　　bNewEdit = False
End Sub

Private Sub Form_BeforeInsert(Cancel As Integer)
　　Call Me.Parent.NewMyItemReset(myNo)
　　bNewEdit = True
End Sub

Private Sub Form_BeforeUpdate(Cancel As Integer)
　　If (Me.NewRecord) Then
　　　　Me.txt11 = Nz(DMax(Me.txt11.ControlSource, Me.RecordSource), 0) + 1
　　　　If (Len(Me.txt12.ControlSource) > 0) Then
　　　　　　Me.txt12 = Me.Parent.GetMyParentItem(myNo)
　　　　End If
　　End If
End Sub

Private Sub Form_AfterUpdate()
　　Dim sSql As String

　　If ((bNewEdit) And (Me.FilterOn) And (Len(Me.txt12.ControlSource) > 0)) Then
　　　　sSql = "UPDATE " & Me.RecordSource & " SET use = False " _
　　　　　　　　& "WHERE " & Me.Filter & " ;"
　　　　CurrentDb.Execute sSql
　　End If
　　Call Me.Parent.NewMyItemSet(myNo, Me.txt11)
　　bNewEdit = False
End Sub

「F2」のVBA

Dim CSUB(1 To 4) As Variant

Private Sub initCnst()
　　CSUB(1) = Array("txt1", "受付ID", "1,T受付2,受付日付,担当者,受付ID,")
　　CSUB(2) = Array("txt2", "見積ID", "2,T見積2,見積日付,見積内容,見積ID,受付ID")
　　CSUB(3) = Array("txt3", "契約ID", "3,T契約2,契約日付,契約内容,契約ID,見積ID")
　　CSUB(4) = Array("txt4", "完了ID", "4,T完了2,完了日付,完了内容,完了ID,契約ID")
End Sub

Public Function GetMyFilter(iNum As Integer) As String
　　Dim s As String

　　GetMyFilter = ""
　　s = Me(CSUB(iNum)(0))
　　If (Len(s) > 0) Then
　　　　GetMyFilter = CSUB(iNum)(1) & " = " & s
　　End If
End Function

Public Function GetMyParentItem(iNum As Integer) As Long
　　Dim i As Integer
　　Dim s As String

　　GetMyParentItem = 0
　　i = iNum - 1
　　If (i > 0) Then
　　　　s = Me(CSUB(i)(0))
　　　　If (Len(s) = 0) Then
　　　　　　GetMyParentItem = 0
　　　　Else
　　　　　　GetMyParentItem = CLng(s)
　　　　End If
　　End If
End Function

Public Sub NewMyItemReset(iNum As Integer)
　　Dim i As Integer

　　If (Len(Me(CSUB(iNum)(0))) = 0) Then Exit Sub

　　DoCmd.Echo False
　　For i = iNum To 4
　　　　Me("txt" & i) = ""
　　Next
　　For i = iNum + 1 To 4
　　　　With Me("FSUB" & i)
　　　　　　.Visible = False
　　　　　　.SourceObject = ""
　　　　End With
　　Next
　　DoCmd.Echo True
End Sub

Public Sub NewMyItemSet(iNum As Integer, iSrc As Long)
　　Dim sTxt As String

　　DoCmd.Echo False
　　sTxt = CSUB(iNum)(0)
　　If (Me(sTxt) <> iSrc) Then
　　　　Me(sTxt) = iSrc
　　　　Me.lst1 = IdMake(Me.txt1.Value, Me.txt2.Value, Me.txt3.Value, Me.txt4.Value)
　　End If
　　Me.lst1.Requery
　　Call ShowFSub(iNum)
　　With Me("FSUB" & Choose(iNum, 2, 3, 4, 1))
　　　　.SetFocus
　　　　.Form.txt1.SetFocus
　　End With
　　DoCmd.Echo True
End Sub

Public Sub ReShow(iNum As Integer)
　　DoCmd.Echo False
　　Call lst1_Click
　　With Me("FSUB" & iNum)
　　　　.SetFocus
　　　　.Form.txt1.SetFocus
　　End With
　　DoCmd.Echo True
End Sub

Private Sub ShowFSub(iNum As Integer)
　　Dim i As Integer
　　Dim bShow As Boolean

　　bShow = True
　　For i = iNum To 4
　　　　With Me("FSUB" & i)
　　　　　　If (bShow) Then
　　　　　　　　Me.Tag = CSUB(i)(2)
　　　　　　　　.SourceObject = "FS2"
　　　　　　　　.Visible = True
　　　　　　　　If (Len(Me(CSUB(i)(0))) = 0) Then bShow = False
　　　　　　Else
　　　　　　　　.Visible = False
　　　　　　　　.SourceObject = ""
　　　　　　End If
　　　　End With
　　Next
　　Me.Tag = ""
End Sub

Private Sub init()
　　Dim i As Integer

　　Me.lst1 = Null
　　Me.lst1.Requery

　　For i = 1 To 4
　　　　Me("txt" & i) = ""
　　　　With Me("FSUB" & i)
　　　　　　.Visible = False
　　　　　　.SourceObject = ""
　　　　End With
　　Next
End Sub

Private Sub Form_Load()
　　Call initCnst
　　Call init
End Sub

Private Sub lst1_Click()
　　DoCmd.Echo False
　　Me.txt1 = Me.lst1.Column(1)
　　Me.txt2 = Me.lst1.Column(3)
　　Me.txt3 = Me.lst1.Column(5)
　　Me.txt4 = Me.lst1.Column(7)
　　Call ShowFSub(1)
　　DoCmd.Echo True
End Sub

Private Sub btn1_Click()
　　DoCmd.Echo False
　　Call init
　　DoCmd.Echo True
End Sub

Private Sub btn2_Click()
　　DoCmd.Echo False
　　Call init
　　Me.Tag = CSUB(1)(2)
　　With Me("FSUB1")
　　　　.SourceObject = "FS2"
　　　　.Visible = True
　　　　.SetFocus
　　　　.Form.txt1.SetFocus
　　End With
　　Me.Tag = ""
　　DoCmd.Echo True
End Sub

多分、うまく説明できていないと思います。

まあ、チョコチョコといじってみてください。

今回１つのフォームを４つのサブフォームコントロールで使いまわししてみましたが、
個々のフォームを作った方が処理は考えやすいし、、早く作成できると思います。

サンプルは以下

バージョン	2000	2003 (2002)	2007
ファイル	kEnt101_2000.zip	kEnt101_2003.zip	kEnt101_2007.zip
サイズ	41,241	41,965	47,284

※ ファイルは zip 形式

※ 2007 以外は、2007 保存時に変換 & 各バージョンで動作確認 & 最適化

関連記事

2011/10/10

Category: サンプルかな

TB： 0 / CM： 0

top △

« 更新できないクエリでどうにか
 サブフォームのFilter »

この記事に対するコメント

top △

コメントの投稿

top △

トラックバック

トラックバックURL
→http://kikutips.blog13.fc2.com/tb.php/101-8ad8f1b3
この記事にトラックバックする(FC2ブログユーザー)

top △

| h o m e |

日	月	火	水	木	金	土
-	-	-	-	-	1	2
3	4	5	6	7	8	9
10	11	12	13	14	15	16
17	18	19	20	21	22	23
24	25	26	27	28	-	-

～ kiku tips ～

Access VBA が使えたら･･･

スポンサーサイト

表示＝入力なの？

この記事に対するコメント

コメントの投稿

トラックバック

ぶつぶつ

カレンダー

全記事表示リンク

最新記事

カテゴリ

カウンター

自動ＲＳＳ表示機能付きリンク

～ kiku tips ～

Access VBA が使えたら ･･･

スポンサーサイト nw(&#45;&#45;,&#45;&#45;,&#45;&#45;,&#45;&#45;)

表示＝入力なの？ nw(2011,10,10,22)

この記事に対するコメント

コメントの投稿

トラックバック

ぶつぶつ

カレンダー

全記事表示リンク

最新記事

カテゴリ

カウンター

自動ＲＳＳ表示機能付きリンク

　　　　Access VBA が使えたら･･･

スポンサーサイト

表示＝入力なの？