スポンサーサイト 


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

--/--/--

Category: スポンサー広告

TB: --  /  CM: --

top △

××専用(限定)・・・ 


しかし、昨日の雨・・・・すごかったですね。
家の前の道路も、茶色い水が川の様になって流れてました・・・・
今日は朝6時から泥片づけで 2時間半・・・・・
今は、風が吹く度、車が通る度に土ぼこりが舞ってます。


本題に戻って・・・・

限定・・・って言葉に弱いんですけど、
処理を考えた時、「限定」って記述は、簡単になったりしますね。

以下の様な、設問があったとします。

フォーム上に、チェックボックスが並んでいます

■A ■B □C □D ■E

この時、テキストボックスに 「 A B E 」と表示したい。
表示する事は出来たけど・・・チェックボックス「F」を追加・配置した時

■A ■B □C ■F □D ■E

としたら、
「 A B F E 」と得たいのに「 A B E F 」になってしまう・・・・

これは、作成した順( Controls の順 )で判別しているだけではないの ???
ってことで、状況が分からないところもあり・・・・
考えやすい?・・・・いろいろな状況に対応しやすい? ってんで、ADO のインメモリ方法を回答する事に・・・
(インメモリ・・・これについては過去記事で何度か書いていたような気がします)
利点っていえば、必要な情報を取り込んでおいて・・・後、どう料理するか・・・・
自分でソート処理を書かなくても良い・・・・等、ありますけど・・・・
(自分でソートした方が、もしかしたら速いのかもしれない・・・・けど・・・)

回答した内容そのものは後述しますが、動作確認用に作ったフォームは以下になります。
(左:2007 中:2003 右:2000 での見え方 : 2007 での作)

kEnt166_1  kEnt166_2003  kEnt166_2000

チェックボックスを縦に5つ
それぞれのチェックボックスの配置(左位置)を変更できるように・・・・
どのチェックボックスを動かすのかを選択後、スクロールバーを左右に動かすと移動します。

kEnt166_2

このスクロールバーの方法は、
過去記事「自前スクロールバーをクラス化してみた」の横スクロールバーを使っています。
( Access の機能で実現しているので、バージョンを変更しても参照設定でエラーになりません)
興味ありましたら、過去記事も読んでみてください。
 
では、回答した内容は以下

状況が不明なところもありますが、変更しやすい(?)方法での記述にしてみます。
説明は後にして、以下をフォームに記述しておきます。

Private Function MojiGet() As String
  Dim ctl As Control
  Dim sS As String

  With New ADODB.Recordset
    .Fields.Append "名", adVarChar, 255
    .Fields.Append "値", adBoolean
    .Fields.Append "左", adInteger
    .Fields.Append "順", adInteger
    .CursorLocation = adUseClient
    .Open

    For Each ctl In Me.Controls
      Select Case ctl.ControlType
        Case acCheckBox
          sS = ctl.Name
          If (ctl.Controls.Count > 0) Then
            sS = ctl.Controls(0).Caption
          End If
          .AddNew
          .Fields("名") = sS
          .Fields("値") = ctl.Value
          .Fields("左") = ctl.Left
          .Fields("順") = ctl.TabIndex
          .Update
      End Select
    Next

    .Filter = "値 = True"
    .Sort = "左"

    sS = ""
    While (Not .EOF)
      sS = sS & " " & .Fields("名")
      .MoveNext
    Wend
    .Close

    MojiGet = Mid(sS, 2)
  End With
End Function

チェックボックスの状態を順次チェックしていくわけですが、
後での並べ替え( Sort )が楽なように ADO のレコードセットを使っておきます。

> A B Z E
> と表示させたいのに
> A B E Z
> 表示されてしまいます。

これは、おそらく
    For Each ctl In Me.Controls
      Select Case ctl.ControlType

とした場合の、出現順(作った順)で処理されているのだと思います。
上記の記述では、チェックボックスなら
・名前を覚える(チェックボックスにラベルがくっついていたらラベルの標題)
・値を覚える
・左位置を覚える
・タブ移動順を覚える

で、この4つを全部覚えたら
・値 = True で絞込み( Filter )
・並び替えを、左位置昇順
この結果で、「名」を繋げていきます
Filter は使わずに、True の時のみレコードセットに追加・・・でも良いと思います。
並び順をタブ移動順に変更するのも容易です。

また、2段・3段になっていて、上の段から・・・とかなら
"上" フィールドを追加して、ctl.Top も覚えておいてから
Sort で "上, 左" とすれば順に得られれます。( "左, 上" とするとまた違った順に)
もちろん、横並びの Top 値や Left 値は同じにしておく必要はありますが・・・
でも、タブ移動順の方が使えるのかも?

ここで、関数名を MojiGet としたので、テキストボックスに設定する時には
Me.テキストボックス = MojiGet
で、できると思います。

テキストボックスのコントロールソースに =MojiGet() としても表示できますが、
更新のタイミングがうまくとれないと思います。
( Me.Recalc 等で表示更新はされますが)
その時には、このチェックボックスが変更されたら・・・・
という意味で、引数に与えるようにします。( Access さんに教えてあげます)
関数側では、引数は必要としていないので、ダミー的な受けにしておきます。

Private Function MojiGet2(ParamArray vDmy()) As String
  MojiGet2 = MojiGet
End Function

テキストボックスのコントロールソースには、
チェックボックス「A」「B」「C」に変更あったら表示を更新したい場合
 =MojiGet2([A],[B],[C])
とでも記述しておきます。

なお、フォーム上に上記とは別の用途のチェックボックスがあるのであれば、
チェックボックスのプロパティにある「タグ」に識別子を埋めておきます。
「タグ」に設定する文字列は何でもよいので、
例えば、対象外のチェックボックスには設定なし・・・だけとすると

    For Each ctl In Me.Controls
      Select Case ctl.ControlType
        Case acCheckBox
          If (Len(ctl.Tag) > 0) Then ' ★こんな感じの判別
            sS = ctl.Name


※ 冒頭に示した内容では、毎回順を得ていますが、
 順を求めるのは1回で良いので、Form_Load とかでやっておいて、
 以降は求まっていた順を使いながら、True/False を判別・・・・でも良いかも

 ただ、フォーム上では操作が絡むので、応答に満足できれば、このままでも・・・

※ 同じような事をするフォームが複数あるのであれば、
 関数部分を標準モジュールに移動させ、
 ・ Private → Public
 ・ Me.Controls → CodeContextObject.Controls
 の変更で動くかも(未検証)

※ ADO のレコードセットを使わなくても、「タグ」に順を設定するとか・・・
 でも、追加した後、その「タグ」修正を間違わない・・・注意が必要ですね
 上記では、追加したら「タグ」に何かを入れておけば・・・・楽かな?
 いろいろ方法はあると思います。

ADO でのインメモリを使ったのには、何を基準に並び替えるか・・・・
これ、Sort に指定するものを何にするか・・・でコロコロ変更が容易・・・・これが第一にあります。
情報を TYPE なりの配列に作り込んでから、自分で配列をソート・・・・
これでも良いと思いますけど、対象を変更したら・・・・それなりの変更量があるのかな??
Sort = "××"   この ×× を変更するだけで対応できるのは、そこそこのメリットかも・・・

ということで、確認用のフォームを作っていきます。
確認では、順で得る・・・これはもちろんですが、

テキストボックスのコントロールソースを使った場合の表示更新状況・・・・これも確認します。
チェックボックス「A」「B」「C」に変更あったら表示を更新したい場合
 =MojiGet2([A],[B],[C])
とでも記述しておきます。
この部分ですね。


フォーム「F1」の作成

kEnt166_1

まず、横スクロールバー用のクラス(clsSBH)を、
過去記事サンプル kEnt112_2007 からインポートしておきます。
フォームデザインから作っていきます。確認したいのは、
・作った順 ・タブ移動順 ・左位置順 の3つになるので気をつけて作っていきます。

基本となるチェックボックスを配置します。
そのチェックボックスをコピーして、4回貼り付けます。
が、貼り付けたら配置を変更していきます。(縦に並べていきます)
現状画像で見えている「A」~「E」は、「A」:基準となったチェックボックス
で、貼り付けた順は、「C」「E」「D」「B」
よって、Controls から得られる順は、「A」「C」「E」「D」「B」
チェックボックスの名前は、上から「cb1」~「cb5」として、タブ移動順も「cb1」~「cb5」にします。
移動対象を選択する為のオプショングループ「op1」をトグルボタンで作成
(ビルダを使って作成する段階で、同じ文字列は指定できないので、仮の文字列「レ1」~「レ5」を指定)
(後でVBAで、選択されたものに「★」表示する様に処理を組み込んでいますが・・・)
(たぶん、この方が認識しやすいのかな???)
スクロールバー用のサブフォームコントロール「FSUB」を配置
順を表示するテキストボックス「txt1」~「txt5」を配置
作成順用  :txt1
タブ移動順用:txt2
左位置順用 :txt3
左位置順用 2(コントロールソース設定確認用):txt4
左位置順用 3(コントロールソース設定確認用):txt5
クリア用のコマンドボタン「btn1」 (クリアはチェックボックスの位置を元に戻すだけ)
取得用のコマンドボタン「btn2」

まずは、記述した全部は以下の様になってます。
Private Const IPX = 567
Dim WithEvents Bar As clsSBH


Private Function MojiGet(iSel As Long) As String
  Dim ctl As Control
  Dim sS As String

  With New ADODB.Recordset
    .Fields.Append "名", adVarChar, 255
    .Fields.Append "値", adBoolean
    .Fields.Append "左", adInteger
    .Fields.Append "順", adInteger
    .CursorLocation = adUseClient
    .Open

    For Each ctl In Me.Controls
      Select Case ctl.ControlType
        Case acCheckBox
          sS = ctl.Name
          If (ctl.Controls.Count > 0) Then
            sS = ctl.Controls(0).Caption
          End If
          .AddNew
          .Fields("名") = sS
          .Fields("値") = ctl.Value
          .Fields("左") = ctl.Left
          .Fields("順") = ctl.TabIndex
          .Update
      End Select
    Next

    .Filter = "値 = True"
    Select Case iSel
      Case 1
      Case 2: .Sort = "順"
      Case 3: .Sort = "左, 名"
    End Select

    sS = ""
    While (Not .EOF)
      sS = sS & " " & .Fields("名")
      .MoveNext
    Wend
    .Close

    MojiGet = Mid(sS, 2)
  End With
End Function

Private Function MojiGet2(iSel As Long, ParamArray vDmy()) As String
  MojiGet2 = MojiGet(iSel)
End Function


Private Sub init()
  Dim i As Long

  For i = 1 To 5
    With Me("cb" & i)
      .Left = (i + 1) * IPX
      If (.Controls.Count > 0) Then
        .Controls(0).Left = .Left + IPX * 0.5
      End If
    End With
  Next
  Call op1_Click
End Sub

Private Sub Form_Load()
  Me.op1 = 1
  Set Bar = New clsSBH
  Bar.Bind Me.FSUB, Me.op1, 2 * IPX, 10 * IPX, Me("cb" & Me.op1).Left
  Call init
  Me.txt4.ControlSource = "=MojiGet(3)"
  Me.txt5.ControlSource = "=MojiGet2(3,[cb1],[cb3],[cb5])"
End Sub

Private Sub op1_Click()
  Dim ctl As Control
  Dim sS As String

  For Each ctl In Me.op1.Controls
    Select Case ctl.ControlType
      Case acToggleButton
        sS = ""
        If (ctl.OptionValue = Me.op1) Then sS = "★"
        ctl.Caption = sS
    End Select
  Next
  Bar.Value = Me("cb" & Me.op1).Left
End Sub

Private Sub Bar_Change(ByVal Value As Long)
  With Me("cb" & Me.op1)
    .Left = Value
    If (.Controls.Count > 0) Then
      .Controls(0).Left = .Left + IPX * 0.5
    End If
  End With
End Sub

Private Sub btn1_Click()
  Call init
End Sub

Private Sub btn2_Click()
  Me.Painting = False
  Me.txt1 = MojiGet(1)
  Me.txt2 = MojiGet(2)
  Me.txt3 = MojiGet(3)
  Me.Recalc
  Bar.Value = Me("cb" & Me.op1).Left
  Me.Painting = True
End Sub

 
回答からの変更点は、
Private Function MojiGet(iSel As Long) As String
に、引数を持たせた事・・・

同じ処理を使って、・作った順 ・タブ移動順 ・左位置順 を切り替えようというもの・・・
iSel は、上記を 1 ~ 3 で指定する様に・・・
で、中の処理では・・・・というと
    .Filter = "値 = True"
    Select Case iSel
      Case 1
      Case 2: .Sort = "順"
      Case 3: .Sort = "左, 名"
    End Select
に変わっただけ・・・・
※ .Sort = "左, 名" にしたのは、確認用で縦に並べてしまったので、
左位置が一緒だったら名前の順にしておきましょうか・・・・というもの・・・・・

  Me.txt4.ControlSource = "=MojiGet(3)"
  Me.txt5.ControlSource = "=MojiGet2(3,[cb1],[cb3],[cb5])"
で、表示更新の違いをみる事に・・・
※ txt5 の表示は、「A」「C」「E」に変更あったら更新されるはず・・・・・

スクロールバーの設定では、
Dim WithEvents Bar As clsSBH
で、宣言しておいて、フォームの読み込み時で
  Set Bar = New clsSBH
  Bar.Bind Me.FSUB, Me.op1, 2 * IPX, 10 * IPX, Me("cb" & Me.op1).Left
として、
・Me.FSUB を使ってください
・スクロールバーの動きが止まった時には、Me.op1 にフォーカスを戻してください
・最小値は 左から2cm のところの値で
・最大値は 左から10cm のところの値で
・今の値はオプショングループで選ばれていたチェックボックスの左位置ですよ

  Bar.Value = Me("cb" & Me.op1).Left
値はオプショングループで選ばれていたチェックボックスの左位置にしてください
この記述は2か所にあるんですが
・オプショングループが選択し直されたら
・取得時 Me.Recalc した後・・・・
この2つ目・・・ Recalc するとサブフォームは先頭に戻ってしまうようなので・・・再指定・・・でしょうか
Private Sub Bar_Change(ByVal Value As Long)
  With Me("cb" & Me.op1)
    .Left = Value
    If (.Controls.Count > 0) Then
      .Controls(0).Left = .Left + IPX * 0.5
    End If
  End With
End Sub
上記はスクロールバーが移動した(値が変わった)通知なので、チェックボックスの左位置を設定・・・
(ラベルの位置も一緒に)
ま、これは、最小値/最大値に移動可能の範囲を指定していたので、得た値をそのまま設定で・・・

※ スクロールバー表示の動かす四角い部分?・・・これを少し小さくしたかったので
インポートしたクラス「clsSBH」の以下部分を変更
Private Const MyWidth As Long = 15 * 567

Private Const MyWidth As Long = 30 * 567
スクロールバーに使うフォームの幅を15cm → 30cm に

※ 使うフォーム名は
Private Const MyFormName As String = "F_SBH"
で宣言してますが、初めに動いた時、このフォームがなければ作るようになっているので
変更したら・・・・そのフォームを削除して・・・1回動かせばフォームは出来上がるので・・・・

Me.op1 にフォーカスが戻るのは、
・スクロールバーをいじって、位置が動かなくなってからのほぼ1秒後・・・・
マウスクリック(ドラッグ?)したままでも、動かなければフォーカスが移動します。
フォーカスが移った後でもスクロールバーは動かせますが、移動したイベントは上がりません。
その時には、もう一度クリックし直せば動きだします。
現状、これが仕様という事で・・・・

で、フォームは出来上がったので、いろいろ位置をずらしながら確認してみてください。



さて、ここからが標題の意味するものになりますが・・・・
質問者さんは、「タブ移動順」で解決されたそうです。

じゃ、上記を「タブ移動順」専用に変更していきたいと思います。

フォーム「F2」の作成

kEnt166_3

フォーム「F1」を「F2」名でコピーします。
(タブ移動順の確認では、位置を動かして・・・・これ、不要ですが遊びも含めて・・・ってことで)
作成順/左位置順は使わないので、「txt1」「txt3」は削除しておきます。

基本的な考え方ですが・・・
タブ移動順・・・フォームを表示した後、順を入れ替えたり・・・・あまりないでしょう・・・
(私は時々いじる事はありますが)
という事で、
フォーム読み込み時に、チェックボックスのタブ移動順でコントロール名の文字列を作っておきます。
後は、その文字列を分解して・・・・順に True / False を確認・・・・
ってな具合で・・・

記述した全部は以下
Private Const IPX = 567
Dim WithEvents Bar As clsSBH
Dim sCtls As String

Private Function MojiGet() As String
  Dim sS As String
  Dim v As Variant

  sS = ""
  For Each v In Split(sCtls, " ")
    With Me(v)
      If (.Value) Then
        If (.Controls.Count > 0) Then v = .Controls(0).Caption
        sS = sS & " " & v
      End If
    End With
  Next
  MojiGet = Mid(sS, 2)
End Function

Private Function MojiGet2(ParamArray vDmy()) As String
  MojiGet2 = MojiGet
End Function


Private Sub init()
  Dim i As Long

  For i = 1 To 5
    With Me("cb" & i)
      .Left = (i + 1) * IPX
      If (.Controls.Count > 0) Then
        .Controls(0).Left = .Left + IPX * 0.5
      End If
    End With
  Next
  Call op1_Click
End Sub

Private Sub Form_Load()
  Dim sAry() As String
  Dim ctl As Control

  ReDim sAry(Me.Controls.Count - 1)
  For Each ctl In Me.Controls
    With ctl
      Select Case .ControlType
        Case acCheckBox
          sAry(.TabIndex) = .Name
      End Select
    End With
  Next
  With CreateObject("VBScript.RegExp")
    .Pattern = "\s+"
    .Global = True
    sCtls = .Replace(Trim(Join(sAry, " ")), " ")
  End With

  Me.op1 = 1
  Set Bar = New clsSBH
  Bar.Bind Me.FSUB, Me.op1, 2 * IPX, 10 * IPX, Me("cb" & Me.op1).Left
  Call init
  Me.txt4.ControlSource = "=MojiGet()"
  Me.txt5.ControlSource = "=MojiGet2([cb1],[cb2],[cb3],[cb4],[cb5])"
End Sub

Private Sub op1_Click()
  Dim ctl As Control
  Dim sS As String

  For Each ctl In Me.op1.Controls
    Select Case ctl.ControlType
      Case acToggleButton
        sS = ""
        If (ctl.OptionValue = Me.op1) Then sS = "★"
        ctl.Caption = sS
    End Select
  Next
  Bar.Value = Me("cb" & Me.op1).Left
End Sub

Private Sub Bar_Change(ByVal Value As Long)
  With Me("cb" & Me.op1)
    .Left = Value
    If (.Controls.Count > 0) Then
      .Controls(0).Left = .Left + IPX * 0.5
    End If
  End With
End Sub

Private Sub btn1_Click()
  Call init
End Sub

Private Sub btn2_Click()
  Me.Painting = False
  Me.txt2 = MojiGet
  Me.Recalc
  Bar.Value = Me("cb" & Me.op1).Left
  Me.Painting = True
End Sub

 

Dim sCtls As String
コントロール名群を設定する変数を宣言しておいて

  Dim sAry() As String
  Dim ctl As Control

  ReDim sAry(Me.Controls.Count - 1)
  For Each ctl In Me.Controls
    With ctl
      Select Case .ControlType
        Case acCheckBox
          sAry(.TabIndex) = .Name
      End Select
    End With
  Next
  With CreateObject("VBScript.RegExp")
    .Pattern = "\s+"
    .Global = True
    sCtls = .Replace(Trim(Join(sAry, " ")), " ")
  End With
フォームのコントロール数分の配列を用意してから
チェックボックスなら、タブ移動順のところにコントロール名を格納
処理しきったら、
・その配列をスペース区切りで JOIN し、
・前後のスペースを排除後、
・中間の連続スペースを1個のスペースに置換え
(置換えに VBScript.RegExp を使ってみた)

関数 MojiGet は、タブ移動順専用にしたので引数はなし
タブ移動順で出来上がっていた文字列を Split で分解し、順にチェック&文字列作成
Private Function MojiGet() As String
  Dim sS As String
  Dim v As Variant

  sS = ""
  For Each v In Split(sCtls, " ")
    With Me(v)
      If (.Value) Then
        If (.Controls.Count > 0) Then v = .Controls(0).Caption
        sS = sS & " " & v
      End If
    End With
  Next
  MojiGet = Mid(sS, 2)
End Function

で、今回のコントロールソース指定では、
  Me.txt4.ControlSource = "=MojiGet()"
  Me.txt5.ControlSource = "=MojiGet2([cb1],[cb2],[cb3],[cb4],[cb5])"
として、txt5 には全チェックボックスを指定してみる・・・・

やはり、専用(限定)となると、それ用のことだけ考えれば良いので、楽といえば楽??

サンプルは以下
 バージョン 20002003 (2002)2007
 ファイル kEnt166_2000.zipkEnt166_2003.zipkEnt166_2007.zip
 サイズ 38,45141,08042,915
※ ファイルは zip 形式
※ 2007 以外は、2007 保存時に変換 & 各バージョンで動作確認 & 最適化



追記(8/11)

回答でも、確認用サンプルでも、タブ移動順は Me.Controls から得ていましたが、
実際(タブ移動順)は、ヘッダ・詳細・フッタ それぞれで別管理されているようです。
つまり、タブ移動順 = 0 のものは、ヘッダ・詳細・フッタ それぞれに存在する・・・・

なので、詳細部分のコントロールの・・・・であれば、
Me.Controls ではなく Me.Section(acDetail).Controls から入手すべきですね。


なお、フォーム「F2」の記述では、コントロール名を覚えておく方法としましたが、
Controls(xx) の xx を覚えておいて・・・・っていう方法もありますね。( xx は数値)
そっちの方が若干速くなるのかも・・・
でも、名前で持っていた方がデバッグ等は楽になる ???
ま、後は考え方になると思います。

全チェックボックスを対象とした以下記述
  Me.txt5.ControlSource = "=MojiGet2([cb1],[cb2],[cb3],[cb4],[cb5])"

  Me.txt5.ControlSource = "=MojiGet2([" & Replace(sCtls, " ", "],[") & "])"
に変更することも簡単だし・・・
関連記事

2013/08/10

Category: サンプルかな

TB: --  /  CM: 0

top △

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

top △

コメントの投稿

Secret

top △


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