FC2ブログ

スポンサーサイト 


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

--/--/--

Category: スポンサー広告

TB: --  /  CM: --

top △

Excel Like 一覧表示入力フォームの模索 


旧記事掲載:2010/02/17

Excel から Access へ移行したい、って言った時、一覧での穴埋め的な入力がイメージとして強いと思います。
テーブルでは入力されたものだけを管理し、
入力時には入力していないものも一覧表示するフォームについて考えてみます。
過去に回答した「Accessで時間外管理の作成について」をベースにいろいろ作ってみました。

基本的なフォームは以下の様になります。
kEnt92

一覧として表示する基準は何年何月の日付、
その日付に対して穴埋め的にデータを入力していくものになります。
回答した時のレコードセットは「ダイナセット(矛盾を許す)」でしたが、
「ダイナセット」にしたバージョン、等などメニューを用意しました。
kEnt92_Menu

入力されたデータだけを蓄積していくという点ではどれも同じです。
作った主要なフォーム「F1」「F2」「F3」「F4」画面は以下の様になっています。
kEnt92_F1 kEnt92_F2 kEnt92_F3 kEnt92_F4

「F1」は、条件付き書式を使用し、「区分」選択でどちらを入力可能にするか制御。
 親子フォームにしたらどうなるの、ってのも、これに関して作ってみてます。
「F2」は、「区分」の既定を設定しておき、その既定でどちらを入力可能にするか、
「F3」「F4」は、テーブルの構成を変更したもので、
「F3」は、「F2」の画面表示と同じくするためには、、、
「F4」は、変更したテーブル構成で素直に実現するには、、、
というものになります。
また、Excel に出力してみたらどうなる???ってのも作ってみたけど、、、

なお、「F2」「F3」「F4」は、コントロールを重ねて表示することをしています。
kEnt92_image
 
【基本的な構成部分】

テーブルは「T休日区分」「T時間外」「T社員」「T月日」の4つ

「T休日区分」の項目は、区分、内容
区分: 長整数(主キー)
内容: テキスト型

データは、
区分、内容
0   "" (空文字列)
1   休日

の2つのみ

「T時間外」の項目は、an、pno、日付、区分、平日普通、平日深夜、休日普通、休日深夜
an: オートナンバー(主キー)
pno: 社員特定用数値で長整数
日付: 日付/時刻型
区分: 長整数
残りは、単精度浮動小数点

区分は、ルックアップで「T休日区分」をコンボボックスで
値集合ソース: T休日区分
連結列: 1
列数: 2
列見出し: いいえ
列幅: 0cm;1cm
入力チェック: はい

「T社員」の項目は、pno、pcode、pname
pno: 社員特定用数値で長整数
pcode: 社員番号用のテキスト型
pname: 社員名用のテキスト型

「T月日」の項目は、日
日: 日付/時刻型

「T月日」の用途は、フォームへ一覧表示する基準となる日付群を格納しておき、
その日付に対応したデータ入力があると「T時間外」へ格納する。


作り方)

上記テーブルを作成します。

フォームをウィザードで簡単に作成するために、クエリ「Q時間外」を先に以下内容で作っておきます。
(誰用は、フォーム上のコンボボックス cbx01 から拾うようにしておきます)
SELECT T月日.日, T1.区分, T1.平日普通, T1.平日深夜, T1.休日普通, T1.休日深夜, T1.pno, T1.日付
FROM T月日 LEFT JOIN
(SELECT * FROM T時間外 WHERE T時間外.pno=Nz(Forms![F時間外]!cbx01,0)) AS T1 ON T月日.日=T1.日付
ORDER BY T月日.日;

以下の手順でフォーム「F時間外」を作成します。
・ウィザードを使用してフォームを作成するから
・クエリ:Q時間外の以下フィールドを選択
 日、 区分、 平日普通、 平日深夜、 休日普通、 休日深夜
・表形式を選択
・フォーム名を「F時間外」とし、フォームのデザイン編集

フォームのデザイン画面になるので、プロパティを表示させます。

フォームの以下プロパティを変更
「追加の許可」->「いいえ」
「レコードセット」->「ダイナセット (矛盾を許す)」

詳細部分
・左側にある「日」のプロパティ
  「書式」->「m/d」に、「編集ロック」->「はい」へ
  この設定の他に、フォーカスが入ったら区分へ移動するように処理は入れておきます。
・平日普通、 平日深夜、 休日普通、 休日深夜 の書式を 0.0 へ

フォームヘッダ部分を縦方向に広げ、以下を追加。
・社員コード表示用テキストボックス「txt00」を作成
 プロパティで、「編集ロック」->「はい」
 (コンボボックスで社員を選択した時に表示するだけに使用)

・社員選択用コンボボックス「cbx01」を作成
 値集合ソースは以下
SELECT T社員.pno, T社員.pname AS 氏名, T社員.pcode AS 番号 FROM T社員 ORDER BY T社員.pname;

 列数:3
 列幅:0cm;3cm;0cm
 連結列:1
 入力チェック:はい

・年月指定用テキストボックス「txt01」を作成
 プロパティで、「IME 入力モード」->「オフ」

フォームフッター部分を広げて以下を追加
・詳細部分の、平日普通、 平日深夜、 休日普通、 休日深夜 をコピーして、フッター部分に貼り付け。
 名前を左から、txt11、txt12、txt13、txt14 に変更し、
 それぞれのコントロールソースを、合計用に書き換えます。
 txt11 なら =Sum([平日普通]) に書き換えます。
 また、「編集ロック」->「はい」へ

VBAの記述内容は以下
' 表示対象範囲(日付)生成
Private Sub MakeMonthDays(dt As Date)
  Dim rs As New ADODB.Recordset
  Dim wdt As Date
  Dim iDayCount As Integer
  Dim i As Integer

  Me.txt01 = Format(dt, "yyyymm")
  wdt = DateValue(Format(dt, "yyyy/mm/01"))
  iDayCount = DateDiff("d", wdt, DateAdd("m", 1, wdt))
  CurrentProject.Connection.Execute "DELETE * FROM T月日;"
  rs.Open "T月日", CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic
  For i = 1 To iDayCount
    rs.AddNew
    rs("日") = wdt
    rs.Update
    wdt = wdt + 1
  Next
  rs.Close
End Sub

' 初期表示、社員選択なし&表示対象範囲(日付)を今月へ
Private Sub Form_Load()
  Me.txt00 = ""
  Me.cbx01 = Null
'  Call MakeMonthDays(Date)
  Call MakeMonthDays(#3/1/2009#)
  Me.Requery
End Sub

Private Sub Form_Dirty(Cancel As Integer)
  If (IsNull(Me.cbx01)) Then
    Cancel = True
  End If
End Sub

' 更新/追加の前で、「T時間外」登録に必要な「日付」「pno」を他から設定
Private Sub Form_BeforeUpdate(Cancel As Integer)
  Me.日付 = Me.日
  Me.pno = Me.cbx01
  If (IsNull(Me.区分)) Then Me.区分 = 0
End Sub

' 行選択後削除されると「T月日」「T時間外」の対象レコードが削除されるので
' 表示対象範囲(日付)を再生成する
Private Sub Form_AfterDelConfirm(Status As Integer)
  If (Status = acDeleteOK) Then
    Call MakeMonthDays(DateSerial(CInt(Left(Me.txt01, 4)), CInt(Right(Me.txt01, 2)), 1))
    Me.Requery
  End If
End Sub


' 表示月変更
' 更新前処理では入力が正当か判別
' 正当なら Tag へ処理年月格納、ダメなら Cancel=True
' 更新後処理では、Tag 経由で得られる処理年月で表示対象範囲を再生成
Private Sub txt01_BeforeUpdate(Cancel As Integer)
  Dim sTmp As String
  Dim sYear As String
  Dim sMonth As String
  Dim wdt As Date
  Dim iECount As Integer

  sTmp = Trim(Nz(Me.txt01.Text))
  Select Case Len(sTmp)
    Case 1, 2
        sYear = Format(Date, "yyyy")
        sMonth = sTmp
    Case 3
        sYear = Left(Format(Date, "yyyy"), 3) & Left(sTmp, 1)
        sMonth = Right(sTmp, 2)
    Case 4
        sYear = Left(Format(Date, "yyyy"), 2) & Left(sTmp, 2)
        sMonth = Right(sTmp, 2)
    Case 5
        sYear = Left(sTmp, 4)
        sMonth = Right(sTmp, 1)
    Case 6
        sYear = Left(sTmp, 4)
        sMonth = Right(sTmp, 2)
    Case Else
        sYear = ""
  End Select
  If (Len(sYear) = 0) Then
    Cancel = True
    Exit Sub
  End If

  On Error GoTo ERRHAND
  iECount = 0
  wdt = DateValue(sYear & "/" & sMonth & "/01")
  Me.txt01.Tag = Format(wdt, "yyyymm")
  Exit Sub

ERRHAND:
  iECount = iECount + 1
  If (iECount <= 1) Then
    Select Case Len(sTmp)
      Case 2
          sYear = Left(Format(Date, "yyyy"), 3) & Left(sTmp, 1)
          sMonth = Right(sTmp, 1)
          Resume
      Case 3
          sYear = Left(Format(Date, "yyyy"), 2) & Left(sTmp, 2)
          sMonth = Right(sTmp, 1)
          Resume
    End Select
  End If
  Cancel = True
End Sub

Private Sub txt01_AfterUpdate()
  Call MakeMonthDays(DateSerial(CInt(Left(Me.txt01.Tag, 4)), CInt(Right(Me.txt01.Tag, 2)), 1))
  Me.Requery
End Sub

Private Sub cbx01_GotFocus()
  Me.cbx01.Dropdown
End Sub

' 社員変更
Private Sub cbx01_Click()
  If (Not IsNull(Me.cbx01)) Then
    Me.txt00 = Me.cbx01.Column(2)
  Else
    Me.txt00 = ""
  End If
  Me.Requery
End Sub

Private Sub 日_Enter()
  Me.区分.SetFocus
End Sub


Private Sub Form_Close()
  DoCmd.OpenForm "F_MENU"
End Sub

 

概要

テーブル「T月日」は処理対象の日付が入るワーキング用テーブルです。
複数人同時に処理するのであれば、操作する人個々に必要なものなので工夫が必要です。

入力したデータのみ、テーブル「T時間外」に格納されて行きます。
社員とデータの関連付けは、「pno」で行います。
(コードや名前は付属情報として扱います)

年月指定用テキストボックス「txt01」の表示は、YYYYMM です。
が、入力は月だけで・・・等の判別処理します。

後々の集計作業では、テーブル「T時間外」を操作します。

このフォームの初期表示年月は、200903 になっています。
(作ったデータサンプルが、その年月だったので)
フォームの読み込み時(Form_Load)で処理するようにします。

レコードセレクタを使用して削除操作すると、両方のテーブルから対象のものが削除されます。
基準としている日付用のデータが欠けるので日付を作り直しします。
作り直したくない、本来のデータ「T時間外」のものだけを削除したい、といった場合は、
十択問題までサポートする選択問題用サンプル で紹介した中の
「連結フォームでの削除操作をフラグ操作に置き換える」を流用してみてください。

これで、基本となるフォーム「F時間外」の完成となります。
kEnt92_0

【レコードセットをダイナセットで扱う様にするには】
kEnt92_1

ダイナセットで扱うためには、テーブルを結び付けた日付部分の一側に主キーを設定します。
テーブル「T月日」を「T月日主キー設定」名でコピー後、フィールド「日」に主キーを設定します。
フォーム「F時間外」を「F月日主キー設定」名でコピー後、レコードセットをダイナセットに変更します。
レコードソース部分は1度削除し、
ビルダからクエリ「Q時間外」のSQL内容を、参照フォーム名を変更して貼り付け保存します。
フォームの更新前処理の、
  Me.日付 = Me.日
は不要になるので削除しておきます。
日付を設定するテーブルを変更したので、変更したテーブルに対して日付を作成するように変更します。

この変更をしたものが、フォーム「F月日主キー設定」になります。


【F1:区分を入力切り分けに使用する】
kEnt92_F1

平日用、休日用が同一レコード上にあるので、どちらを入力するのか決めてもらうまで入力不可とします。
区分に入力あったら該当する側だけに入力を許可するようにします。
この入力可/不可の制御に条件付き書式を使用します。

フォーム「F月日主キー設定」を「F1」名でコピーし、レコードソース内の参照フォーム名を変更します。
詳細部分の「平日普通」「平日深夜」を選択し、以下の条件で条件付き書式を設定します。
条件1: 式で、[区分] Is Null として、無効に
条件2: 式で、[区分]<>0 として、無効に
詳細部分の「休日普通」「休日深夜」を選択し、以下の条件で条件付き書式を設定します。
条件1: 式で、[区分] Is Null として、無効に
条件2: 式で、[区分]<>1 として、無効に

また、日付部分で土曜、日曜がわかりやすいように条件付き書式を設定します。
条件1: 式で、Weekday([日])=7 として、薄青に
条件2: 式で、Weekday([日])=1 として、薄赤に

前回までのフォームでは、レコード編集中でも、年月、社員を変更でき、
変更するとエラーを呼び起こすものであったので、Dirty を判別する以下処理を追加しています。

社員選択時のフォーカス取得時、編集中なら年月へフォーカス移動
Private Sub cbx01_Enter()
  If (Me.Dirty) Then txt01.SetFocus
End Sub

年月の更新前処理先頭で、編集中なら Cancel = True
Private Sub txt01_BeforeUpdate(Cancel As Integer)
  ・・・・

'  処理先頭で
  If (Me.Dirty = True) Then
    Cancel = True
    Exit Sub
  End If
  ・・・・
  ・・・・

コンボボックスでフォーカスが入らないようにしているのには以下の理由があります。
コンボボックスの更新前処理で Cancel = True で戻っても、表示等は操作通り更新されてしまう動きをしているみたい・・・
Private Sub cbx01_BeforeUpdate(Cancel As Integer)
  If (Me.Dirty = True) Then
    Cancel = True
  End If
End Sub

見た目も変更できないようにするには、以下の様に Undo してあげる必要があります。
Private Sub cbx01_BeforeUpdate(Cancel As Integer)
  If (Me.Dirty = True) Then
    Cancel = True
    Me.cbx01.Undo
  End If
End Sub

今回は、編集中でイリーガルな操作をしていることをメッセージではない形で表現するために、
他へフォーカスを移動することとしました。
テキストボックスの更新前処理での Cancel = True は、書き換えても次に進まないので、
間違った操作だとわかるでしょう。

また、データの更新前処理で、入力されたデータをチェックするようにします。
チェック対象である、平日普通、 平日深夜、 休日普通、 休日深夜 のタグに "NZC" を設定しておき、
更新前処理で、タグが "NZC" のものに入力なければ 0.0 を代入。
1レコードの値を加算したものが 0.0 なら、入力がなかったものとして Cancel = True


【F1_1:区分を入力切り分けに使用する に、コピペでExcel出力を追加】
kEnt92_F1_1

フォーム「F1」を「F1_1」名でコピーし、レコードソース内の参照フォーム名を変更します。
フォームヘッダ部にコマンドボタン「btn01」を配置します。
コマンドボタンのクリック時に、
データシート形式サブフォームのExcel出力で紹介した「コピペでExcel」処理を追加します。
※現在、まだ旧エントリーをアップしていません。詳細はのちほどで・・・・
今回はサブフォームが対象ではないので、サブフォームへのフォーカス移動は必要ありません。

この、コピペでExcel 処理でのExcel内容が実行環境で異なったので、その結果もzipに入れてあります。
Access2000 + Win 2k では、データのないところもきれいに罫線が引かれているのに対して、
Access2003 + XP Pro / Access2007 + Vista では、データのあるところだけに罫線が引かれてました。

また、どの部分がコピペされるか確認してみてください。


【F1_2:区分を入力切り分けに使用する に、自力でExcel出力を追加】
kEnt92_F1_2

フォーム「F1_1」を「F1_2」名でコピーし、レコードソース内の参照フォーム名を変更します。
コマンドボタン「btn01」のクリック時を、以下に書き換えます。
Private Sub btn01_Click()
  Dim oApp As Object
  Dim iRow As Long
  Dim sTmp As String
  Dim i As Long
  Const iRowStart = 4
  Const iColStart = 2

  If (Not IsNull(Me.cbx01) And Me.Dirty = False) Then
    Set oApp = CreateObject("Excel.Application")
    oApp.Workbooks.Add

    iRow = iRowStart
    oApp.Cells(iRow, iColStart + 0) = "日付"
    oApp.Cells(iRow, iColStart + 1) = "区分"
    oApp.Cells(iRow, iColStart + 2) = "平日普通"
    oApp.Cells(iRow, iColStart + 3) = "平日深夜"
    oApp.Cells(iRow, iColStart + 4) = "休日普通"
    oApp.Cells(iRow, iColStart + 5) = "休日深夜"

    With Me.RecordsetClone
      .MoveFirst
      While (Not .EOF)
        iRow = iRow + 1
        oApp.Cells(iRow, iColStart + 0).NumberFormatLocal = "m/d (aaa)"
        oApp.Cells(iRow, iColStart + 0) = .Fields("日")
        If (Not IsNull(.Fields("pno"))) Then
          If (Nz(.Fields("区分"), 0) <> 0) Then
            oApp.Cells(iRow, iColStart + 1) = "休日"
          End If
          oApp.Cells(iRow, iColStart + 2).NumberFormatLocal = "0.0_ "
          oApp.Cells(iRow, iColStart + 2) = .Fields("平日普通")
          oApp.Cells(iRow, iColStart + 3).NumberFormatLocal = "0.0_ "
          oApp.Cells(iRow, iColStart + 3) = .Fields("平日深夜")
          oApp.Cells(iRow, iColStart + 4).NumberFormatLocal = "0.0_ "
          oApp.Cells(iRow, iColStart + 4) = .Fields("休日普通")
          oApp.Cells(iRow, iColStart + 5).NumberFormatLocal = "0.0_ "
          oApp.Cells(iRow, iColStart + 5) = .Fields("休日深夜")
        End If
        .MoveNext
      Wend
    End With

    iRow = iRow + 1
    oApp.Cells(iRow, iColStart + 0) = "計"
    sTmp = "=Sum(R[-" & iRow - (iRowStart + 1) & "]C:R[-1]C)"
    For i = iColStart + 2 To iColStart + 5
      oApp.Cells(iRow, i).NumberFormatLocal = "0.0_ "
      oApp.Cells(iRow, i).FormulaR1C1 = sTmp
    Next

    oApp.Columns.EntireColumn.AutoFit
    oApp.Cells(iRowStart + 1, iColStart + 1).Select
    oApp.ActiveWindow.FreezePanes = True
    oApp.Cells(2, 1) = Left(Me.txt01, 4) & "年"
    oApp.Cells(3, 1) = Me.cbx01.Column(1)
    
    oApp.Cells(1, 1).Select
    oApp.Visible = True
    Set oApp = Nothing
  End If
End Sub

自由にデザインできる等メリットがありますが、処理時間はかかるようです。
最後の1行には、合計の意味で"計"として Excel の Sum 関数を使ってみました。
Range を使って一気に書式設定等、変更点はいっぱいあると思いますが、これはこれで良しとします。


【F1_M / F1_S:区分を入力切り分けに使用する を親子フォームに、コピペでExcel出力を追加】
kEnt92_F1_M

フォーム「F1_1」をベースに、親子フォームを作っていきます。
フォーム「F1_1」を「F1_M」「F1_S」名で2つコピーします。

フォーム「F1_M」を親側、「F1_S」を子側として変更していきます。

子側「F1_S」への変更

レコードソース内の参照フォーム名を親フォーム「F1_M」に変更します。
フォームヘッダ部分を全削除し、高さ0にします。
フォームフッター部分のテキストボックスを不可視に変更し、高さを狭めておきます。
VBAで記述されているヘッダ部分の処理を削除します。
また、ヘッダ部分を参照していた部分の記述は、相対で親を参照するように変更します。
親が使っている関数も、親を参照実行するように変更します。

子側に残ったVBA記述は以下の通りです。
Private Sub Form_Open(Cancel As Integer)
  On Error Resume Next
  If (Me.Parent.Name <> "F1_M") Then
    Cancel = True
  End If
End Sub

Private Sub Form_Dirty(Cancel As Integer)
  If (IsNull(Me.Parent.cbx01)) Then
    Cancel = True
  End If
End Sub

' 更新/追加の前で、「T時間外」登録に必要な「pno」を他から設定
Private Sub Form_BeforeUpdate(Cancel As Integer)
  Dim ctl As Control
  Dim sgTmp As Single

  sgTmp = 0#
  For Each ctl In Me.Section(acDetail).Controls
    If (ctl.Tag = "NZC") Then
      If (IsNull(ctl)) Then ctl = 0#
      sgTmp = sgTmp + ctl
    End If
  Next

  If (sgTmp = 0#) Then
    Cancel = True
  Else
    Me.pno = Me.Parent.cbx01
  End If
End Sub

' 行選択後削除されると「T月日主キー設定」「T時間外」の対象レコードが削除されるので
' 表示対象範囲(日付)を再生成する
Private Sub Form_AfterDelConfirm(Status As Integer)
  If (Status = acDeleteOK) Then
    Call Me.Parent.MakeMonthDays(DateSerial(CInt(Left(Me.Parent.txt01, 4)), _
                    CInt(Right(Me.Parent.txt01, 2)), 1))
    Me.Requery
  End If
End Sub


Private Sub 日_Enter()
  Me.区分.SetFocus
End Sub

 
親側「F1_M」への変更

レコードソースを空欄にし、既定のビューを単票フォームに変更します。
レコードセレクタ、移動ボタンは不要なので、プロパティで表示しないようにします。
詳細部分のコントロールは不要なので、全部削除し、サブフォームを表示するため領域を大きくします。
サブフォームコントロールを配置し、名前を「FSUB」とします。
「FSUB」のプロパティで、ソースオブジェクトを「F1_S」に設定します。
フッター部分の txt11 ~ txt14 のコントロールソースを以下内容で書き換えます。
txt11 のコントロールソース: =FSUB!txt11
txt12 のコントロールソース: =FSUB!txt12
txt13 のコントロールソース: =FSUB!txt13
txt14 のコントロールソース: =FSUB!txt14

サブフォーム「F1_S」のフッターの不可視である合計部分を参照するようにします。
データの編集中にヘッダ部分の値を更新しないように入れておいた処理は、この構成になると要らなくなるので、VBA部分を削除しておきます。(サブフォームが編集中なら、親フォームには制御が渡ってこないので)
VBA記述数か所で再クエリを行っていますが、対サブフォーム用に書き換えます。

親側に残ったVBA記述は以下の通りです。
' 表示対象範囲(日付)生成
Public Sub MakeMonthDays(dt As Date)
  Dim rs As New ADODB.Recordset
  Dim wdt As Date
  Dim iDayCount As Integer
  Dim i As Integer

  Me.txt01 = Format(dt, "yyyymm")
  wdt = DateValue(Format(dt, "yyyy/mm/01"))
  iDayCount = DateDiff("d", wdt, DateAdd("m", 1, wdt))
  CurrentProject.Connection.Execute "DELETE * FROM T月日主キー設定;"
  rs.Open "T月日主キー設定", CurrentProject.Connection, adOpenForwardOnly, adLockOptimistic
  For i = 1 To iDayCount
    rs.AddNew
    rs("日") = wdt
    rs.Update
    wdt = wdt + 1
  Next
  rs.Close
End Sub

' 初期表示、社員選択なし&表示対象範囲(日付)を今月へ
Private Sub Form_Load()
  Me.txt00 = ""
  Me.cbx01 = Null
'  Call MakeMonthDays(Date)
  Call MakeMonthDays(#3/1/2009#)
  Me.FSUB.Form.Requery
End Sub


Private Sub btn01_Click()
  Dim oApp As Object

  If (Not IsNull(Me.cbx01)) Then
    Set oApp = CreateObject("Excel.Application")
    oApp.Workbooks.Add

    Me.FSUB.SetFocus
    DoCmd.RunCommand acCmdSelectAllRecords
    DoCmd.RunCommand acCmdCopy

    oApp.Activesheet.Paste
    Call ClearCopyData
    oApp.Columns.EntireColumn.AutoFit
    oApp.Visible = True
    Set oApp = Nothing
    Me.btn01.SetFocus
  End If
End Sub


' 表示月変更
' 更新前処理では入力が正当か判別
' 正当なら Tag へ処理年月格納、ダメなら Cancel=True
' 更新後処理では、Tag 経由で得られる処理年月で表示対象範囲を再生成
Private Sub txt01_BeforeUpdate(Cancel As Integer)
  Dim sTmp As String
  Dim sYear As String
  Dim sMonth As String
  Dim wdt As Date
  Dim iECount As Integer

  sTmp = Trim(Nz(Me.txt01.Text))
  Select Case Len(sTmp)
    Case 1, 2
        sYear = Format(Date, "yyyy")
        sMonth = sTmp
    Case 3
        sYear = Left(Format(Date, "yyyy"), 3) & Left(sTmp, 1)
        sMonth = Right(sTmp, 2)
    Case 4
        sYear = Left(Format(Date, "yyyy"), 2) & Left(sTmp, 2)
        sMonth = Right(sTmp, 2)
    Case 5
        sYear = Left(sTmp, 4)
        sMonth = Right(sTmp, 1)
    Case 6
        sYear = Left(sTmp, 4)
        sMonth = Right(sTmp, 2)
    Case Else
        sYear = ""
  End Select
  If (Len(sYear) = 0) Then
    Cancel = True
    Exit Sub
  End If

  On Error GoTo ERRHAND
  iECount = 0
  wdt = DateValue(sYear & "/" & sMonth & "/01")
  Me.txt01.Tag = Format(wdt, "yyyymm")
  Exit Sub

ERRHAND:
  iECount = iECount + 1
  If (iECount <= 1) Then
    Select Case Len(sTmp)
      Case 2
          sYear = Left(Format(Date, "yyyy"), 3) & Left(sTmp, 1)
          sMonth = Right(sTmp, 1)
          Resume
      Case 3
          sYear = Left(Format(Date, "yyyy"), 2) & Left(sTmp, 2)
          sMonth = Right(sTmp, 1)
          Resume
    End Select
  End If
  Cancel = True
End Sub

Private Sub txt01_AfterUpdate()
  Call MakeMonthDays(DateSerial(CInt(Left(Me.txt01.Tag, 4)), CInt(Right(Me.txt01.Tag, 2)), 1))
  Me.FSUB.Form.Requery
End Sub

Private Sub cbx01_GotFocus()
  Me.cbx01.Dropdown
End Sub

' 社員変更
Private Sub cbx01_Click()
  If (Not IsNull(Me.cbx01)) Then
    Me.txt00 = Me.cbx01.Column(2)
  Else
    Me.txt00 = ""
  End If
  Me.FSUB.Form.Requery
End Sub


Private Sub Form_Close()
  DoCmd.OpenForm "F_MENU"
End Sub

 

≪ここからのフォームはコントロールを重ねた表示を使っていきます≫
kEnt92_image

【F2:区分を入力切り分けに使用する変形】
kEnt92_F2 kEnt92_F2_1

既定で、土日は休日、その他は平日、として、標準で入力側が切り替わっていた方が便利かも???
既定から外れる時には、区分を変更する。ということで、サンプルを作ってみました。
日付によって個別に既定値を持つことはできないので、
既定値用のコントロールを重ねて表示する方法にしました。

フォーム「F1」を「F2」名でコピーし、レコードソース内の参照フォーム名を変更します。
詳細部分の「区分」のタブストップを「いいえ」に変更します。
「区分」をコピー&貼り付けし「区分」真上に重ねます。
マウス右ボタンクリックの「コントロールの種類の変更」でテキストボックスに変更します。
名前を「txt21」に変更し、コントロールソースに以下を設定します。
=IIf([区分] Is Null,IIf(Weekday([日],7)<=2,"休日",""),IIf([区分]<>0,"休日",""))

区分データがない時、日付から土曜日基準の曜日を求め、土日なら"休日"を表示
(土曜日基準なら、土曜=1、日曜=2)
区分データがあった場合、0 でなかったら"休日"を表示

この「txt21」では、フォーカスが入っただけでは何もせず、
クリックされた時には下にある「区分」へフォーカスを移すように処理を入れます。
(下にあるものでも、フォーカスを当てると前面に出てきます)
その後、「区分」のフォーカス取得後で、
どっちを既定としていたのか「txt21」の表示内容から値を代入しながらリストを表示するようにします。
クリックした時は変更したい時だろう、、、として、値を代入することにしました。

詳細部分の「平日普通」「平日深夜」を選択し、以下の条件で条件付き書式を設定します。
条件1: 式で、[区分] Is Null And [txt21]<>"" として、無効に
条件2: 式で、[区分]<>0 として、無効に
詳細部分の「休日普通」「休日深夜」を選択し、以下の条件で条件付き書式を設定します。
条件1: 式で、[区分] Is Null And [txt21]<>"休日" として、無効に
条件2: 式で、[区分]<>1 として、無効に

フォームの更新前処理では、区分が入力されていない時の処理を追加します。
(「txt21」の表示で判別するように)

VBAで変更した部分
Private Sub Form_BeforeUpdate(Cancel As Integer)
  Dim ctl As Control
  Dim sgTmp As Single
  Dim iTmp As Long

  sgTmp = 0#
  For Each ctl In Me.Section(acDetail).Controls
    If (ctl.Tag = "NZC") Then
      If (IsNull(ctl)) Then ctl = 0#
      sgTmp = sgTmp + ctl
    End If
  Next

  If (sgTmp = 0#) Then
    Cancel = True
  Else
    Me.pno = Me.cbx01
    iTmp = 0
    If (Me.txt21 = "休日") Then iTmp = 1
    If (IsNull(Me.区分)) Then Me.区分 = iTmp
  End If
End Sub

Private Sub 日_Enter()
  Me.txt21.SetFocus
End Sub


VBAで追加した部分

Private Sub 区分_GotFocus()
  Dim iTmp As Long

  iTmp = 0
  If (Me.txt21 = "休日") Then iTmp = 1
  If (Not IsNull(Me.cbx01) And IsNull(Me.区分)) Then Me.区分 = iTmp
  Me.区分.Dropdown
End Sub

Private Sub txt21_Click()
  Me.区分.SetFocus
End Sub

 
ただ、この方法になると、「区分」をテーブル「T休日区分」に分けた意味が薄れるような。
区分が増えればテーブルに追加するだけで動きます・・・ってのが良いのですが、
条件付き書式の判別やVBAの処理で、それらの値を切り分け設定するのは、変更箇所が多くなります。
今回は目をつぶるということに、、、


≪F3 / F4 はデータの持ち方を変えての内容になります≫
kEnt92_F3 kEnt92_F4 kEnt92_F4_1

テーブル「T時間外」を「T残業」に変更します。
項目で平日用、休日用の区別はしません。
区別は、「区分」で行います。

「T残業」の項目は、an、pno、日付、区分、普通、深夜
an: オートナンバー(主キー)
pno: 社員特定用数値で長整数
日付: 日付/時刻型
区分: 長整数
残りは、単精度浮動小数点

区分のルックアップは、「T時間外」と同じ

テーブルの項目は変わりましたが、
以前のフォーム「F2」とほぼ同じ見え方/操作できるフォーム「F3」
テーブルが変わったのだから、変わったなりのフォーム「F4」

テーブル「T時間外」を「T残業」に変更します。
項目で平日用、休日用の区別はしません。
区別は、「区分」で行います。

「T時間外」の項目は、an、pno、日付、区分、平日普通、平日深夜、休日普通、休日深夜
「T残業」の項目は、an、pno、日付、区分、普通、深夜

区分のルックアップは、「T時間外」と同じ

【F3:「F2」とほぼ同じ見え方/操作できるように】
kEnt92_F3

テーブルの項目が変わったわけですが、
フォーム上では「F2」同様、平日/休日の区別ある形での構成としてみます。

フォーム「F2」を「F3」名でコピーし、レコードソースを以下に変更します。
SELECT T月日主キー設定.日, T1.区分, T1.普通, T1.深夜, T1.pno
FROM T月日主キー設定 LEFT JOIN
(SELECT * FROM T残業 WHERE T残業.pno=Nz(Forms![F3]!cbx01,0)) AS T1 ON T月日主キー設定.日=T1.日付
ORDER BY T月日主キー設定.日;

2つのテキストボックスのコントロールソースに、同一フィールドを指定することをするので、
詳細部分の、テキストボックス名 平日普通、平日深夜、休日普通、休日深夜 を
左から、txt22、txt23、txt24、txt25 に変更します。
txt22、txt24 のコントロールソースを、「普通」に変更します。
txt23、txt25 のコントロールソースを、「深夜」に変更します。
入力チェック用に設定しているタグ "NZC" は、
txt22 と txt23、txt24 と txt25 のどちらかの組み合わせにあればよいので、
txt22 と txt23 のタグを削除しておきます。

既に設定してある、txt22 ~ txt25 の条件付き書式はそのまま使います。
(「F2」作成時に設定したものになります)

txt22 ~ txt25 を選択、コピーし貼り付け後、元の位置に重ねます。
名前を左から txt32 ~ txt35 に変更します。
条件付き書式はそのまま使います。
タブストップを「いいえ」に変更します。
txt32 のコントロールソースを、=IIf([区分]=0,[普通],"") に
txt33 のコントロールソースを、=IIf([区分]=0,[深夜],"") に
txt34 のコントロールソースを、=IIf([区分]=1,[普通],"") に
txt35 のコントロールソースを、=IIf([区分]=1,[深夜],"") に変更します。

「区分」がNULL の時は??というと、[区分]=0 部分でエラーになり NULL 扱いになるものと思います。
データが入っていない時には表示しないので、結果オーライとします。

txt32 ~ txt35 のクリック時に、下側へフォーカスを移動するように処理を記述します。

フォームフッター部に配置した合計を求める記述を、以下に変更します。(左から)
txt11 のコントロールソースを、=Sum(IIf([区分]=0,[普通],0)) に
txt12 のコントロールソースを、=Sum(IIf([区分]=0,[深夜],0)) に
txt13 のコントロールソースを、=Sum(IIf([区分]=1,[普通],0)) に
txt14 のコントロールソースを、=Sum(IIf([区分]=1,[深夜],0)) に変更します。

VBAの記述は、というと、「F2」での記述から削除/変更したものはありません。
ただ、追加したのはフォーカスを移動するための以下記述だけです。
Private Sub txt32_Click()
  Me.txt22.SetFocus
End Sub
Private Sub txt33_Click()
  Me.txt23.SetFocus
End Sub
Private Sub txt34_Click()
  Me.txt24.SetFocus
End Sub
Private Sub txt35_Click()
  Me.txt25.SetFocus
End Sub

 
【F4:変わったなりのフォーム】
kEnt92_F4

テーブル構成が変わったので、変わったなりのフォームに変更します。

フォーム「F3」を「F4」名でコピーし、レコードソース内の参照フォーム名を変更します。
詳細部分の txt24、txt25、txt32 ~ txt35 を削除します。
txt22 の名前を「普通」、txt23 の名前を「深夜」に変更します。
入力チェック用に設定しているタグ "NZC" は、「F3」の時に削除していたので、追加しておきます。
txt22、txt23 に対応するヘッダ部のラベルの表示も「普通」「深夜」に変更します。

今回は、どの行を示しているのか、行で背景色を付けてみます。
ヘッダ部にどの行(日付)にいるのかを格納する非表示のテキストボックス「txt_day」を配置します。
レコード移動時に「txt_day」に「日」を設定します。
詳細部分の各テキストボックスの条件付き書式で、
「日」と「txt_day」が同じ時に背景色を設定するようにします。
テキストボックス「日」の条件付き書式には、土日用の条件が既に設定されているので、
それらの条件を1つづつ後ろにずらし、1つ目に以下を設定します。
条件を式として、[日]=[txt_day] で背景色を設定
また、前面に配置している「txt21」と、「普通」「深夜」にも同じ条件を設定します。
なお、「普通」「深夜」に設定されていた条件は削除しておきます。

画面の変更は以上で、VBA記述では、「F3」で追加したフォーカス移動部分を削除し、
レコード移動時に以下を記述します。
Private Sub Form_Current()
  Me.txt_day = Me.日
End Sub

変更は以上です。


が、「F4」をそのまま Access2000 + Win 2k で動かすと、トチ狂ってくるようです。
「2000のために F4_1」の方で動かしてください。
(チョット処理を変えてますが、見え方はほぼ一緒??)
ただ、2000形式のものを他で動かす分には大丈夫なようです。

※ 何故狂う?
雰囲気でしかわかりませんが、「F4」は「F2」のようにコントロールを重ねています。
さらにこの画面では、選択しているレコードを示す為に「日」をキーとして条件付き書式を設定しています。
この社員を選択していない状態で、区分をクリック、他の区分をクリック、さらに他の区分をクリック、、、
していくと、チラチラチラチラと表示がやかましくなっていきます。
そして・・・
重ね合わせ+条件付き書式 の組み合わせが原因???


【F4_1:2000用に変更してみた】
kEnt92_F4_1

フォーム「F4」を「F4_1」名でコピーし、レコードソース内の参照フォーム名を変更します。
コントロールを重ねて条件付き書式を設定した「txt21」から条件付き書式を削除します。
下側のコントロール「区分」に条件付き書式を同じ条件で設定します。

ただこのままでは、
「区分」の背景色が見えないので、上側の「txt21」の背景スタイルを「透明」に変更します。
また、境界線が上下でズレても何なんで、境界線スタイルも「透明」に変更します。

コンボボックスの右側ボタン(?)部分が見えるようになりましたが、チラチラ動作は解消されました。

変更点は以上です。


あまり凝る必要はないと思います。

サンプルは以下
 バージョン 20002003 (2002)2007
 ファイル kEnt92_2000.zipkEnt92_2003.zipkEnt92_2007.zip
 サイズ 140,585146,298158,409
※ ファイルは zip 形式
※ 2007 以外は、2007 保存時に変換 & 各バージョンで動作確認 & 最適化

※ なお、1度データ入力後、区分変更してもう一方側に入力した場合などの処理は入れてません。

※ Excel出力のある各フォームで出力したファイルは、各 zip に全て入れてあります。
2000 で始まるものは、Access2000 + Win 2k
2003 で始まるものは、Access2003 + XP Pro (下位バージョンで保存)
2007 での出力は、2003 と同じだったので入れてません。
Excel ファイルは当時のままです。
関連記事

2011/07/09

Category: サンプルかな

TB: 0  /  CM: 0

top △

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

top △

コメントの投稿

Secret

top △

トラックバック

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

top △


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