FC2ブログ

スポンサーサイト 


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

--/--/--

Category: スポンサー広告

TB: --  /  CM: --

top △

表示=入力なの? 


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

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

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

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

ここで、以下のようなテーブルがあり、リレーションシップが設定されているとします。
kEnt101R
この時、一連の設定状況を見ながら入力/更新していくには・・・・
(上の段と、下の段は同じものです。後述する処理で単に別物としただけです)

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

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

上記テーブル構成を考えた時、以下のようなフォームを考えてみました。
kEnt101  kEnt101D
で、サブフォーム部分は右側4段ですが、そこに使っているのは
kEnt101SB
で、どのテーブルに対して・・・・固定情報は持たないようにしました。
 
サブフォーム「FS1」の作成

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

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

この時、例えば、親の Tag に
"2,T見積,見積日付,見積内容,見積ID,受付ID" とあれば、
私は2番
対象のテーブルは「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」の作成

親はフォームデザインで作成していきます。
単票として、「レコードセレクタ」「移動ボタン」は「いいえ」にしておきます。
4つのテーブルを簡易に表示するものとしてリストボックス「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 はユーザ定義関数として、標準モジュールに記述したもので、
一覧にした時に、そのレコードを1意に特定するための文字列を作るもので
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



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

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


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


サンプルは以下
 バージョン 20002003 (2002)2007
 ファイル kEnt101_2000.zipkEnt101_2003.zipkEnt101_2007.zip
 サイズ 41,24141,96547,284
※ ファイルは zip 形式
※ 2007 以外は、2007 保存時に変換 & 各バージョンで動作確認 & 最適化

関連記事

2011/10/10

Category: サンプルかな

TB: 0  /  CM: 0

top △

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

top △

コメントの投稿

Secret

top △

トラックバック

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

top △


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