FC2ブログ

スポンサーサイト 


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

--/--/--

Category: スポンサー広告

TB: --  /  CM: --

top △

帳票サブフォーム間の同期 


以下の様な質問を見ていました。

メインフォームに 帳票のサブフォームが2つあり、
片方のサブフォーム内のレコードを移動させたら、
同時にもう片方の方も自動的にレコード移動をさせたい。

理由は、テーブル内のフィールド数が255個までのため分割しており、
本来、両方合わせて1つのレコードなので・・・

かなりのフィールド数が必要で、同一主キーでテーブルを分けているんでしょうか・・・
サブフォーム内のスクロールバーの値を使って同期させる方法は Web 上に情報ありますね。

違う方面からアプローチしてみようか・・・・ということで、

以下のテーブル「T1」があるとします。
anF1F2F3F4
1122012/07/012012/08/01
2242012/07/022012/08/02
3362012/07/032012/08/03
4482012/07/042012/08/04
55102012/07/052012/08/05
66122012/07/062012/08/06
77142012/07/072012/08/07
88162012/07/082012/08/08
99182012/07/092012/08/09
1010202012/07/102012/08/10
1111222012/07/112012/08/11
1212242012/07/122012/08/12
1313262012/07/132012/08/13
「an」はオートナンバ

このテーブル1つを使って、
左側サブフォームの表示を、「an」「F1」「F3」
右側サブフォームの表示を、「an」「F2」「F4」

各サブフォーム内でレコードを選択したら、選択したレコードを先頭に表示し、
他のサブフォームも、同じ「an」部分を選択して先頭に表示するように・・・・

kEnt136_F3M  kEnt136_F3M_1  kEnt136_F3M_2
左図:初期表示
中図:左側サブフォームで「an」= 4 のレコードを選択
右図:右側サブフォームで「an」= 9 のレコードを選択

つまり、共通で使える「an」を元に、選択したものを先頭に揃えましょう・・・・ってな感じ

kEnt136_F4M
左側サブフォームで「an」= 6 のレコードを選択

この方法でやれば、詳細部分の高さを、サブフォーム間で一致させておく必要はありません。
ただし、スクロールバーを動かした場合、表示が同期されることはありません。
あくまでもレコードを選択した時・・・・になります。


※ Me.CurrentSectionTop を見ながら DoCmd.GoToPage を使って・・・・
こういう使い方の情報は探せなかったので、たまたま動いているレベルのものなのかも・・・

【追記】帳票フォームで固定行スクロール も合わせて参照ください
 

初めに、帳票フォームの動きを見てみましょうという事で・・・

テーブル「T1」を元に、フォームウィザードで表形式として、フォーム「F1」を作成します。
この時、表示するフィールドは「an」「F1」「F3」の3つだけにしておきます。

ヘッダ部分を広げて、情報を表示するラベル「lab1」を配置します。
移動量を入力するテキストボックス「txt1」と実行用のコマンドボタン「btn1」(並んでいる左側)
先頭表示する「an」入力用テキストボックス「txt2」と実行用のボタン「btn2」(並んでいる右側)
も、配置しておきます。

kEnt136_F1  kEnt136_F1D

ラベル「lab1」への情報表示は、ラベル上をマウスが通ったら・・・(クリックでも)
表示する情報は、
Me.InsideHeight: フォームの高さ
Me.Section(acHeader).Height:ヘッダ部の高さ
Me.Section(acDetail).Height:詳細部分の高さ
Me.ActiveControl.Name / Top:アクティブなコントロールの名前と Top 値
Me.CurrentSectionTop:現在のセクションの Top 値

記述した VBA は
Private Sub lab1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Call lab1_MouseDown(Button, Shift, X, Y)
End Sub

Private Sub lab1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Dim sS As String

  On Error Resume Next
  sS = ""
  sS = sS & "Me.InsideHeight = " & Me.InsideHeight & vbCrLf
  sS = sS & "Me.Section(acHeader).Height = " & Me.Section(acHeader).Height & vbCrLf
  sS = sS & "Me.Section(acDetail).Height = " & Me.Section(acDetail).Height & vbCrLf
  sS = sS & "Me.ActiveControl.Name = " & Me.ActiveControl.Name
  sS = sS & " Top = " & Me.ActiveControl.Top & vbCrLf
  sS = sS & "Me.CurrentSectionTop = " & Me.CurrentSectionTop & vbCrLf
  Me.lab1.Caption = sS
End Sub

Private Sub Form_Load()
  Me.InsideHeight = Me.Section(acHeader).Height _
          + Me.Section(acDetail).Height * 10
  Me.txt1 = Me.Section(acDetail).Height
End Sub

Private Sub btn1_Click()
  Dim i As Integer

  i = Nz(Me.txt1, Me.Section(acDetail).Height)
  Me.an.SetFocus
  If (Me.CurrentSectionTop < Me.InsideHeight) Then
    DoCmd.GoToPage 1, , i
  End If
End Sub

Private Sub btn2_Click()
  Dim i As Long

  i = Nz(Me.txt2, 1)
  With Me.RecordsetClone
    .FindFirst "an = " & i
    If (Not .NoMatch) Then
      Me.an.SetFocus
      Me.Bookmark = .Bookmark
      i = (Me.CurrentSectionTop - Me.Section(acHeader).Height) + Me.Section(acDetail).Height
      i = i \ Me.Section(acDetail).Height
      If (i > 0) Then
        DoCmd.GoToPage 1, , Me.Section(acDetail).Height * i
      End If
    End If
  End With
End Sub

 
まずは、フォーム「F1」を起動して動きを確認してみます。

kEnt136_F1_1

確認ABCDE
Me.InsideHeight59555955595559555955
Me.Section(acHeader).Height17011701170117011701
Me.Section(acDetail).Height426426426426426
Me.CurrentSectionTop01695211516955970

確認A:ヘッダ部テキストボックスをクリック後
確認B:詳細「an」= 1 (先頭)をクリック後
確認C:詳細「an」= 2 (先頭から2番目)をクリック後
確認D:確認C 後、スクロールバーで「an」= 2 を先頭にした後
確認E:確認D 後、スクロールバーで「an」= 3 を先頭にした後

で、雰囲気わかった事

・Me.CurrentSectionTop は、どこにフォーカスがあるかで基準値が違うようだ
 ヘッダ部にフォーカスがあれば 0
 詳細先頭にあれば、= Me.Section(acHeader).Height になると思っていたが、差 6 あり
 (Me.CurrentSectionTop = Me.Section(acHeader).Height - 6)・・・・(1695 = 1701 - 6)
 (ただ、差 6 がどこからきているのか不明)
 (6 で考えられるのは、1cm = 567 の 0.1mm = 6 (567 / 100 の四捨五入?))

・Me.CurrentSectionTop は、確認C - 確認B = 2115 - 1695 = 420 = 詳細の高さ - 6
 (ただ、差 6 がどこからきているのか不明)(「区切り線」の有無は関係ないようだ)
 (ちなみに「an」= 3 の時は 2535 = 1695 + (426 - 6)*2)

・選択したレコードがスクロールにより表示から隠れた場合(上方向/下方向問わず)
 Me.CurrentSectionTop = 5970 = Me.InsideHeight + 15
 フォームの大きさを変更しても、隠れると Me.InsideHeight + 15 になるようだ
 (差 15 がどこからきているのか不明)
 (15 で考えられるのは、(567 / 100)四捨五入後の * 2.5 ( 0.25mm 分)?)

・先頭レコードを変更する時には
  DoCmd.GoToPage 1, , 詳細の高さ * 相対レコード数
 でできる様だ。
 先頭が「an」= 1 の時、「an」= 3 を先頭にしたい時
  詳細の高さ*相対レコード数 = 426 * (3-1) = 852
 (前述の差 6 がどこからきているのかわからないので、詳細の高さそのままで・・・)

・Me.an.SetFocus すると、カレントレコードがスクロールで隠れていても、
 スクロールを戻して、そのレコードを表示しようとする動きの様だ。


この雰囲気を踏まえて VBA を解説すると
Private Sub btn1_Click()
  Dim i As Integer

  i = Nz(Me.txt1, Me.Section(acDetail).Height)
  Me.an.SetFocus
  If (Me.CurrentSectionTop < Me.InsideHeight) Then
    DoCmd.GoToPage 1, , i
  End If
End Sub
では、
・移動量を i に(上に隠れていく時は正で、下方向は負)
・ボタンのクリックによってフォーカスがヘッダ部にあるので、このまま Me.CurrentSectionTop を見ても
 意味が無いので、詳細にある「an」にフォーカス移動( Me.an.SetFocus )
・フォーカス移動によりカレントレコードは必ずどこかに表示されているので(念のため判別)
 DoCmd.GoToPage 1, , i

※ フォーム「F1」を起動後、「an」= 10 位をクリック後、ボタンをクリックしていくと
 1レコードずつ上に移動していくと思います。
 移動後、移動量部分を負(- を付加)にしてボタンをクリックしていくと、順に出てくると思います。

Private Sub btn2_Click()
  Dim i As Long

  i = Nz(Me.txt2, 1)
  With Me.RecordsetClone
    .FindFirst "an = " & i
    If (Not .NoMatch) Then
      Me.an.SetFocus
      Me.Bookmark = .Bookmark
      i = (Me.CurrentSectionTop - Me.Section(acHeader).Height) + Me.Section(acDetail).Height
      i = i \ Me.Section(acDetail).Height
      If (i > 0) Then
        DoCmd.GoToPage 1, , Me.Section(acDetail).Height * i
      End If
    End If
  End With
End Sub
では、入力した「an」値を探して、先頭に表示させようというもの

Me.RecordsetClone 内を検索し、あったらフォーカスを移動し、Bookmark を設定します。
この状態で、対象のレコードはどこかに表示されているはず・・・・

CurrentSectionTop からヘッダ部を引いて・・・・(対象が先頭になっていたら -6 になる)
必ず -6 ・・・なのかわからないので、詳細の高さを加算して正にしておく
(各レコード間の差も 6(426 が 420 の倍数)だけど、20行表示していたとしても 6 * 19 = 114 の誤差)
(この誤差が詳細の高さ(426)以上・・・・これ考えにくいので)
で、求めていた値を詳細の高さで割った商だけを求めておいて・・・・
移動するレコード数が求まったので、先頭でなかったら
 DoCmd.GoToPage 1, , Me.Section(acDetail).Height * i
で移動する。

こんな雰囲気なんでしょうか。

では、このフォームをベースとしたサブフォーム2つを組み込んでいきたいと思います。

手動での同期(F2M / F2S1 / F2S2)

kEnt136_F2M

サブフォーム内で同期したい(先頭に表示したい)レコードを選択後、
「同期」ボタン(「btn1」)をクリックすることで、各サブフォーム内の表示を揃えます。

前述フォーム「F1」を「F2S1」名でコピー後、ヘッダ部の
情報表示用ラベル / 移動量テキスト / 「an」指定テキストと実行ボタン
を削除(必要なのは実行用のコマンドボタン「btn1」1つのみ)し、配置を小さくします。
このフォーム「F2S1」を「F2S2」名でコピーし、表示/編集対象部分を変更します。
(「F1」→「F2」「F3」→「F4」)

新しくフォームをフォームデザインから作成します。
デザインを表示したら「F2S1」「F2S2」をドラッグ&ドロップしてサブフォームとして組み込みます。
左側に「F2S1」を、コントロール名を「FSUB1」に変更、
右側に「F2S2」を、コントロール名を「FSUB2」に変更します。
このフォームを「F2M」とします。

VBA の記述
フォーム「F1」の記述の多くを、各サブフォーム内に記述しても良いのかもしれませんが、
自分を処理した後、相手側も処理しなくてはならない・・・・
相手ってどうやって辿る・・・・面倒くさい・・・
サブフォームを同列で見れる親フォームに共通の処理としてお願いすれば・・・・
相手を知る必要もないし、相手が3つ4つあるかもしれない・・・・(今回、相手は1つですが・・・)

という事で、親「F2M」に共通の処理を置いておいて、必要に応じて各サブフォームから呼び出すように・・・

フォーム「F2M」への記述
Public Sub ShowSync(sName As String, sFind As String)
  Dim rs As DAO.Recordset
  Dim v As Variant
  Dim sCall As String
  Dim i As Long

  For Each v In Array("FSUB1", "FSUB2")
    With Me(v)
      If (.SourceObject = CodeContextObject.Name) Then sCall = v
      .SetFocus
      With .Form
        .Controls(sName).SetFocus
        If (Len(sFind) = 0) Then
          DoCmd.GoToRecord , , acNewRec
        Else
          Set rs = .RecordsetClone
          rs.FindFirst sFind
          If (rs.NoMatch) Then Exit For
          .Bookmark = rs.Bookmark
        End If
        i = (.CurrentSectionTop - .Section(acHeader).Height) + .Section(acDetail).Height
        i = i \ .Section(acDetail).Height
        If (i > 0) Then
          DoCmd.GoToPage 1, , .Section(acDetail).Height * i
        End If
      End With
    End With
  Next
  If (Len(sCall) > 0) Then Me(sCall).SetFocus
End Sub

 
ShowSync(sName As String, sFind As String)
sName:詳細内のフォーカスを設定するコントロール名
sFind:RecordsetClone 内を検索する時の文字列

常にサブフォームコントロール "FSUB1", "FSUB2" の順で処理します。
一連の処理が終わった後、呼び出された元にフォーカスを設定する為に
      If (.SourceObject = CodeContextObject.Name) Then sCall = v
で、どのサブフォームから呼ばれたか覚えておいて
  If (Len(sCall) > 0) Then Me(sCall).SetFocus
で戻しています。
同じ処理するサブフォームが増えたら Array("FSUB1", "FSUB2") 部分を変更するだけ・・・

サブフォーム「F2S1」「F2S2」への記述(同じもの:ボタンクリックで同期)
Private Sub Form_Open(Cancel As Integer)
  On Error Resume Next
  If (Len(Me.Parent.Name) = 0) Then Cancel = True
End Sub

Private Sub btn1_Click()
  Dim sFind As String

  If (Me.Dirty) Then Exit Sub
  sFind = "an = " & Me.an
  If (Me.NewRecord) Then sFind = ""
  Call Me.Parent.ShowSync("an", sFind)
End Sub

Form_Open での処理は、サブフォームとして組み込まれた起動でない場合、起動しない様に・・・
(今回はこの記述で・・・・過去記事に違う記述あり)
ボタンがクリックされたら、
編集中ならやらない・・・・

操作としては、先頭に表示したいレコードを選んで「同期」ボタン(「btn1」)クリック。


選んで、ボタンクリック・・・・これ、操作が面倒なので、
選んだら、選んだものを先頭に表示しましょう・・・・ これが、次の「F3M」「F3S1」「F3S2」


レコード選択での同期(F3M / F3S1 / F3S2)

kEnt136_F3M  kEnt136_F3M_1  kEnt136_F3M_2
フォーム「F2M」「F2S1」「F2S2」を「F3M」「F3S1」「F3S2」としてコピーします。
サブフォーム内の「同期」ボタン(「btn1」)は削除します。
各サブフォームコントロール内のソースオブジェクトを「F3Sx」に変更します。(x は 1 or 2)

サブフォーム「F3S1」「F3S2」の記述は同じ
Private Sub Form_Open(Cancel As Integer)
  On Error Resume Next
  If (Len(Me.Parent.Name) = 0) Then Cancel = True
End Sub

Private Sub Form_Current()
  Dim sFind As String

  If (Not Me.Parent.Visible) Then Exit Sub
  sFind = "an = " & Me.an
  If (Me.NewRecord) Then sFind = ""
  Call Me.Parent.ShowSync("an", sFind)
End Sub
「レコード移動時」(Form_Current)で処理するようにします。
レコード移動時に編集中という事はないので、Me.Dirty 判別は不要に・・・・
起動時に呼ばれたものなのか・・・・初めの1発目の判別を、親の Visible で・・・
起動時、親の Form_Open が呼ばれる前に、組み込まれたサブフォームの処理が動きます。
サブフォームの組み込まれ順(起動順)は同時ではなく、やはり順番・・・・
サブフォーム1つ目の一連の起動処理で Form_Current は1度呼ばれます。が、
他のサブフォームは起動されていないので、親処理内のサブフォームコントロールの .Form ・・・
とした時にエラーになります。
  If (Not Me.Parent.Visible) Then Exit Sub
は、各サブフォーム側ではなく親の処理の中で
  If (Not Me.Visible) Then Exit Sub
とした方が良いのかも・・・・

フォーム「F3M」への記述
Public Sub ShowSync(sName As String, sFind As String)
  Dim rs As DAO.Recordset
  Dim v As Variant
  Dim sCall As String
  Dim sS As String
  Dim i As Long

  For Each v In Array("FSUB1", "FSUB2")
    With Me(v)
      If (.SourceObject = CodeContextObject.Name) Then sCall = v
      .SetFocus
      With .Form
        sS = .OnCurrent
        .OnCurrent = ""
        .Controls(sName).SetFocus
        If (Len(sFind) = 0) Then
          DoCmd.GoToRecord , , acNewRec
        Else
          Set rs = .RecordsetClone
          rs.FindFirst sFind
          If (rs.NoMatch) Then
            .OnCurrent = sS
            Exit For
          End If
          .Bookmark = rs.Bookmark
        End If
        i = (.CurrentSectionTop - .Section(acHeader).Height) + .Section(acDetail).Height
        i = i \ .Section(acDetail).Height
        If (i > 0) Then
          DoCmd.GoToPage 1, , .Section(acDetail).Height * i
        End If
        .OnCurrent = sS
      End With
    End With
  Next
  If (Len(sCall) > 0) Then Me(sCall).SetFocus
End Sub

処理を進める中で、
          DoCmd.GoToRecord , , acNewRec

          .Bookmark = rs.Bookmark
で、レコードを移動することがあります。
この時に、再度サブフォームの Form_Current が動かれると困るので、一旦無効にして・・・その後復元

大体動きとしては、良さそうです。

また、フォーム「F3M」起動時、先頭の表示を「an」= 4 にしたかったら、以下を追加すれば良いですね
Private Sub Form_Load()
  Call ShowSync("an", "an = 4")
End Sub

 

レコード選択での同期 その2(F4M / F4S1 / F4S2)

kEnt136_F4M
ここでは、サブフォームに表示する際、詳細の高さが異なるものにしてみたいと思います。

フォーム「F3M」「F3S1」「F3S2」を「F4M」「F4S1」「F4S2」としてコピーします。
各サブフォームコントロール内のソースオブジェクトを「F4Sx」に変更します。(x は 1 or 2)
「F4S1」「F4S2」の詳細の高さを異なるように変更し、代替えの背景色を変更しておきます。
(2000 / 2003 での表示では意味がありません)

VBA は変更するところはありません。
で、動きを確認してみます。

2000 / 2003 / 2007 で、そこそこ動いているみたいなので、
  DoCmd.GoToPage 1, , 詳細の高さ * 相対レコード数
は、あながち間違いじゃないのかも・・・・


この辺、情報をお持ちの方いらっしゃいましたら、教えてください。


※ そうそう
DoCmd.GoToPage って、Me.GoToPage とか、 フォーム.GoToPage でも良いみたい
(2007 での確認:他は未検証)

どっちが良いのでしょうか・・・・・
DoCmd.GoToRecord , , acNewRec っていう記述もあったので、DoCmd の方にしてましたけど・・・・


※ 新規登録時での同期等は、別途 Requery するとか処理の追加が必要かと・・・・
※ また、FindFirst で一致するものがあることを前提にした NoMatch 処理にしていたので、
  詳細は詰める必要があるかと・・・・

サンプルは以下
 バージョン 20002003 (2002)2007
 ファイル kEnt136_2000.zipkEnt136_2003.zipkEnt136_2007.zip
 サイズ 41,71143,06846,293
※ ファイルは zip 形式
※ 2007 以外は、2007 保存時に変換 & 各バージョンで動作確認 & 最適化

関連記事

2012/08/01

Category: サンプルかな

TB: --  /  CM: 0

top △

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

top △

コメントの投稿

Secret

top △


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