FC2ブログ

スポンサーサイト 


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

--/--/--

Category: スポンサー広告

TB: --  /  CM: --

top △

同時入力したい 


以下のような質問を目にしました。

テキストボックスが xx 個あり、同じ文字列を入力したい。
操作としては、
・入力したいテキストボックスをクリックして、背景色を変更
(入力したいテキストボックスに対して繰り返す)
・入力する文字列を選んでおいて、ボタンのクリックで、背景色を変更したものに入力
・入力が終わったら、背景色を戻す

テキストボックスの個数が多そうなので・・・ フォームは単票で良いでしょうね・・・
で、フォームを考えてみました。
同じ文字列・・・・ 雰囲気、記号(一文字)っぽいので、コンボボックスで選びましょうか・・・
1つのコンボボックスでは操作も何だから、同じものを4つのコンボで操作できるようにしておきましょう・・・
設定するタイミングは、コマンドボタンですね・・・
これも、一箇所というよりは、各コンボの横にあった方が操作しやすいのかな・・・
ということで、
・コンボボックス / コマンドボタンのセットが4つ
・テキストボックスの個数を 80 個
として以下のフォームを作ってみました。

kEnt172

テキストボックスをクリックしたら背景色を変更・・・・

kEnt172_1

これ、認識しやすい(?)様に、テキストボックスに付いているラベルの背景色も変更しましょうか・・・
で、背景色変えて・コンボで選んで・ボタンで入力・・・・

kEnt172_2 → kEnt172_3 → kEnt172_4

現状、このフォームは非連結状態になってますが、
レコードソース / コントロールソースを設定すれば・・・連結でも動くかも・・・

※ なお、このフォームは動きを確認するのが目的ですので・・・・
 テキストボックス内の文字配置が・・・・ とか
 チョッと見栄えが・・・ とか とか  ありますけど・・・・ 大目にみるという事で・・・

以降、
・フォームを作るために記述したもの
・できたフォームに記述したもの
について書いていきます。
 
まずは、フォームを作るために記述したのは以下(標準モジュール「Module1」に・・・)
Const IPX = 567

Public Sub MkFrm()
  Dim frm As Form

  Set frm = CreateForm
  DoCmd.RunCommand acCmdFormHdrFtr

  With frm
    .DefaultView = 0
    .RecordSelectors = False
    .NavigationButtons = False
    .DividingLines = False
    .ScrollBars = 0
    .Section(acFooter).Height = 0
    .PopUp = True
    .AutoCenter = True
    .HasModule = True
  End With

  Call MkHead(frm)
  Call MkDetail(frm)

  Set frm = Nothing
End Sub

Private Sub MkHead(frm As Form)
  Dim i As Long

  On Error Resume Next
  For i = 1 To 4
    With CreateControl(frm.Name, acComboBox, acHeader)
      .Name = "cbx" & i
      .Top = 0.3 * IPX
      .Left = 0.5 * IPX + (i - 1) * 4.3 * IPX
      .Height = 0.5 * IPX
      .Width = 1.5 * IPX
      .RowSourceType = "Value List"
      .RowSource = "'○';'×';'△';'□';'★'"
      .AllowValueListEdits = False
      .TabStop = False
    End With
    With CreateControl(frm.Name, acCommandButton, acHeader)
      .Name = "btn" & i
      .Caption = "設定"
      .Top = 0.2 * IPX
      .Left = 2.1 * IPX + (i - 1) * 4.3 * IPX
      .Height = 0.7 * IPX
      .Width = 2 * IPX
      .TabStop = False
      .Enabled = False
    End With
  Next
  With frm.Section(acHeader)
    .Height = IPX
    .BackColor = RGB(255, 255, 255)
  End With
End Sub

Private Sub MkDetail(frm As Form)
  Dim iTop As Long
  Dim i As Long, j As Long
  Dim iNo As Long

  iNo = 1
  iTop = 0.2 * IPX
  For i = 1 To 8
    If (i <> 1) Then iTop = iTop + 0.8 * IPX
    For j = 1 To 10
      With CreateControl(frm.Name, acTextBox, acDetail)
        .Name = "txt" & iNo
        .Top = iTop
        .Left = IPX + (j - 1) * 1.7 * IPX
        .Height = 0.5 * IPX
        .Width = 0.7 * IPX
        .BackStyle = 1
        .BackColor = RGB(255, 255, 255)
      End With
      With CreateControl(frm.Name, acLabel, acDetail, "txt" & iNo)
        .Name = "lab" & iNo
        .TextAlign = 3
        .Caption = iNo
        .Top = iTop
        .Left = 0.3 * IPX + (j - 1) * 1.7 * IPX
        .Height = 0.5 * IPX
        .Width = 0.6 * IPX
        .BackStyle = 1
        .BackColor = RGB(255, 255, 255)
      End With
      iNo = iNo + 1
    Next
  Next
  frm.Width = 17.3 * IPX
  With frm.Section(acDetail)
    .Height = iTop + 0.8 * IPX
    .BackColor = RGB(255, 255, 255)
  End With
End Sub

 
MkFrm() を起動するとフォームの原型が出来上がります。
※ 2000 / 2003 で作成した場合は、各コントロールの見栄えは違うものになるかもしれません。
 でも、動きを確認するには、十分だと思います。

フォームを作って、ヘッダ/フッタがありますよ・・・
「単票フォーム」「レコードセレクタ:なし」「移動ボタン:なし」
「境界線:なし」 (これ記述していないと、2000 / 2003 では境界線が表示されました)
「スクロールバー:なし」「フッタの高さはありません」
「ポップアップ:はい」「自動中央寄せ:はい」「コード保持:はい」

と、目ぼしいものを設定しておいてから・・・
今回フォームは非連結として作りますが、もし連結にするとしたらテキストボックス部分??
なら、コンボボックス / コマンドボタン は、ヘッダ部に作っておきましょう・・・
・次、ヘッダに配置するものを作って・・・ (コンボボックス / コマンドボタンのセットが4つ)
・その次、詳細部分に配置するものを作って・・・ (テキストボックス / ラベルのセットが 80 個)

作成するコンボボックス名は、「cbx1」~「cbx4」にしましょう。
また、それとセットになるコマンドボタンの名を「btn1」~「btn4」にしましょう。
コンボボックスは「値リスト」で、'○';'×';'△';'□';'★' を設定しておいて、
「値リストの編集の許可」を「いいえ」として、編集できない様にしておきましょう。
コンボボックス / コマンドボタンには、タブストップは不要です・・・・
コンボボックスが選ばれてから、コマンドボタンを有効にしたいので、
コマンドボタンの「使用可能」は初期値「いいえ」としておきます。

で、ヘッダ部の高さと、背景色を設定して・・・ ヘッダ部の設定は終わり。

詳細部分では、
テキストボックス名は「txt1」~「txt80」にしましょう。
ラベル名は「lab1」~「lab80」にしましょう。
それぞれ、背景は普通で、背景色は真っ白に・・・・
詳細部分の背景色、高さ、フォーム自身の幅を設定して・・・ 終わり。


これで、フォームの原型が出来上がります。

※ テキストボックスの背景色を変更する方法として、
 ・色自身を入れ替える
 ・背景色を設定しておいて、背景スタイルの「透明」「普通」を切り替える
この2通りがあると思いますが、今回は前者の色自身を入れ替える事に・・・・
この方法にしたので、「ヘッダ部」「詳細」の背景色を設定していました。
というのは、2000 の場合、色を設定しないと「灰色」が設定される様で・・・・
テキストボックスの背景「白」と・・・ かなりの違和感があったので・・・

以降、フォームに処理を記述していきますが、処理のイメージ概要として、
・コンボボックスで選ぶと、それに対応したコマンドボタンが押せるように
・コマンドボタンがクリックされたら、対象のテキストボックスにコンボボックスのものを設定
・対象のテキストボックス・・・・このデータの持ち方は
 背景を変更することはもちろんの事、Dictionary でテキストボックス名を管理
 テキストボックスがクリックされ、Dictionary にある / ないで、どちらの色を・・・・
・コンボボックス / コマンドボタン / テキストボックス 各処理は、各処理ごとの関数とし、
 ActiveControl で切り分けしながら処理する・・・ 特にこの番号で処理・・・・ という記述はしない

記述したのは以下(実際の記述にはコメントありません)
Dim dic As Object ' クリックされたテキストボックス名管理用
Const sFixBtn As String = "設定" ' コマンドボタン用の基本標題
Const DEFCOLOR As Long = 16777215 ' 基本の背景色
Const CHGCOLOR As Long = 13816815 ' 置換える背景色

Private Sub ChgCtlColor(ctl As Control, bSetC As Boolean) ' テキストボックス背景色変更関数
  Dim iC As Long

  iC = DEFCOLOR
  If (bSetC) Then iC = CHGCOLOR
  With ctl
    .BackColor = iC ' 今回、次の判別は不要だけど、ラベルがくっ付いていたら一緒に背景変更
    If (.Controls.Count > 0) Then .Controls(0).BackColor = iC
  End With
End Sub

Private Function procBtn() ' コマンドボタンがクリックされたら
  Dim v As Variant
  Dim sS As String
  ' クリックされたテキストボックス名を管理している Dictionary をみる・・・これが処理の基本
  If (dic.Count = 0) Then Exit Function
  sS = Me("cbx" & Mid(Me.ActiveControl.Name, 4)) ' コマンドボタンと対のコンボボックスの値
  For Each v In dic.Keys
    Me(v) = sS
    Call ChgCtlColor(Me(v), False)
  Next
  dic.RemoveAll
End Function

Private Function procCombo() ' コンボボックスがクリックされたら対のボタンを設定変更
  Dim sS As String

  With Me.ActiveControl
    If (IsNull(.Value)) Then
      With Me("btn" & Mid(.Name, 4))
        .Caption = sFixBtn
        .Enabled = False
      End With
    Else
      sS = .Value
      With Me("btn" & Mid(.Name, 4))
        .Caption = sS & sFixBtn
        .Enabled = True
      End With
    End If
  End With
End Function

Private Function procDrop() ' コンボボックスにフォーカスが入ってきたらリスト表示
  Me.ActiveControl.Dropdown
End Function

Private Sub HdrInit() ' ヘッダ部の初期設定
  Dim ctl As Control

  For Each ctl In Me.Section(acHeader).Controls
    With ctl
      Select Case .ControlType
        Case acComboBox ' コンボなら初期値 Null でイベント用関数割付け
          .Value = Null
          .OnGotFocus = "=procDrop()"
          .OnClick = "=procCombo()"
        Case acCommandButton ' ボタンなら・・・ でイベント用関数割付け
          .Caption = sFixBtn
          .OnClick = "=procBtn()"
          .Enabled = False
      End Select
    End With
  Next
End Sub

Private Function procTxt() ' テキストボックスがクリックされたら Dictionary をみて背景色変更
  With Me.ActiveControl
    If (dic.Exists(.Name)) Then
      dic.Remove .Name
      Call ChgCtlColor(Me.ActiveControl, False)
    Else
      dic.Item(.Name) = Null
      Call ChgCtlColor(Me.ActiveControl, True)
    End If
  End With
End Function

Private Sub DtlInit() ' 詳細部分の初期設定(テキストボックスのイベント用関数割付け)
  Dim ctl As Control

  For Each ctl In Me.Section(acDetail).Controls
    If (ctl.ControlType = acTextBox) Then
      ctl.OnClick = "=procTxt()"
      Call ChgCtlColor(ctl, False)
    End If
  Next
End Sub

Private Sub Form_Load()
  Set dic = CreateObject("Scripting.Dictionary")
  Call HdrInit
  Call DtlInit
End Sub

 

まぁ、ソコソコ動くと思います。

なお、標準モジュールに記述していた、フォーム作成の記述の後ろに、
作ったフォームに記述するコードがコメントにして付けてあります。

フォームを作った後、そのコメント部分をコピー後有効とするか・・・
サンプルフォーム「F1」の記述をそのままコピーするだけで、動くと思います。


サンプルは以下
 バージョン 20002003 (2002)2007
 ファイル kEnt172_2000.zipkEnt172_2003.zipkEnt172_2007.zip
 サイズ 36,36436,67038,170
※ ファイルは zip 形式
※ 2007 以外は、2007 保存時に変換 & 各バージョンで動作確認 & 最適化

関連記事

2013/09/08

Category: サンプルかな

TB: --  /  CM: 0

top △

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

top △

コメントの投稿

Secret

top △


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