FC2ブログ

スポンサーサイト 


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

--/--/--

Category: スポンサー広告

TB: --  /  CM: --

top △

こんな感じ・・・ 


http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q13104663763

上記の回答時に、作って動作確認したそのままのものをサンプルとして・・・
たぶん、今までの記事では、確認時のものそのまま・・・ってなサンプルはなかったかと・・・
どこかしら、訂正・綺麗に・・・・した後のものだったような・・・

上記質問の内容は、「開始日」「完了日」を元に、ガンチャート(?)風表示している中で、
日曜日の表示(あり/なし)をチェックボックスで切り替えたい・・・

ガンチャート(?)風の記事は過去にも、
帳票フォームで帯表示
帳票フォームで帯入力
ポップアップで時間帯入力
っていうものを作ってましたが、これらは時間帯・・・・
今回のは、日にちによる期間・・・

まぁ・・・チョッと違うものとして記事に・・・・

用意したテーブル「T19」は
an工事ID作業名開始日完了日
11111AAA2013/03/032013/03/21
22222BBB2013/02/122013/03/13
33333CCC2013/01/152013/04/22
44444DDD2013/03/072013/03/28
55555EEE2013/03/112013/03/11

これを元に、フォームウィザードを使用して帳票フォームを作成。
これに、非連結のテキストボックス「a1」~「a31」と、日にち表示用のラベル「lab1」~「lab31」を追加
日曜の表示を除外するか・・・この指定用にチェックボックス「cb1」

ここからフォームが2つに分かれますが、

・非連結部分を月固定表示として扱うために
(年用コンボ「cbx1」、月用コンボ「cbx2」を配置)
(日曜を除外する時には、日曜部分に異なる色を付けるだけ)
kEnt153_1  kEnt153_2

・カレントレコードの「開始日」を基準に非連結部分を作り直す(?)
(日曜の表示を除外する時には、詰めて31日分を表示)
kEnt153_11  kEnt153_12  kEnt153_13
 
まず、基本となるフォームを作成します。
テーブル「T19」を元に、フォームウィザードを使って表形式を指定してフォーム「F_19」を作ります。
基本的な表示調整した後、デザイン表示にしておきます。

ここでですが、テキストボックス、ラベルを各31個綺麗に並べたいので・・・・
そこで、「Module15」に作成した以下を実行します。(手作業より楽です)
Public Sub MakeF_T19()
  Const sFN As String = "F_T19"
  Dim i As Integer
  Dim iTp As Integer, iLt As Integer, iHt As Integer, iWh As Integer
  Dim jTp As Integer, jLt As Integer, jHt As Integer, jWh As Integer

  With Forms(sFN)
    With .Controls("完了日")
      iTp = .Top
      iHt = .Height
      iWh = .Width
      iLt = .Left + iWh + 30
    End With
    For i = 1 To 31
      jLt = iLt + 200 * (i - 1) + 30
      With CreateControl(sFN, acTextBox, acDetail)
        .Name = "a" & i
        .Top = iTp
        .Left = jLt
        .Height = iHt
        .Width = 170
        .TabStop = False
        .BackStyle = 1
        .BackColor = RGB(255, 255, 255)
        .BorderStyle = 1
        .BorderColor = RGB(0, 0, 0)
        .Locked = True
        .Enabled = False
      End With
      With CreateControl(sFN, acLabel, acHeader)
        .Name = "lab" & i
        .Top = 600
        .Left = jLt
        .Height = 350
        .Width = 170
        .BackStyle = 1
        .BackColor = RGB(255, 255, 255)
        .BorderStyle = 1
        .BorderColor = RGB(0, 0, 0)
        .FontSize = 8
        .Caption = i
      End With
    Next
  End With
End Sub

 
※ この記述は、フォーム「F_T19」がデザインで開いている事が前提となっているので・・・・

日曜表示除外用のチェックボックス「cb1」を配置します。
これで、基本となるフォームが出来上がったので各フォームを作っていきます。


フォーム「F_T19元」(初期回答のもの)

kEnt153_1
基本フォームに、
年用コンボ「cbx1」、月用コンボ「cbx2」を配置し、値リストでそこそこデータを設定しておきます。
VBAで以下を記述します。
Private Function DayCheck(dtS As Date, dtE As Date, iNum As Integer) As Integer
  Dim dt As Date

  DayCheck = 0
  dt = DateSerial(Me.cbx1, Me.cbx2, iNum)
  If (Me.cb1) Then
    If (Weekday(dt, vbSunday) = 1) Then
      DayCheck = 1
      Exit Function
    End If
  End If
  If ((dtS <= dt) And (dt <= dtE)) Then DayCheck = 2
End Function

Private Function DayChange()
  Dim dt As Date
  Dim i As Integer, bB As Boolean

  For i = 1 To 31
    dt = DateSerial(Me.cbx1, Me.cbx2, i)
    bB = Month(dt) = Me.cbx2
    Me("a" & i).Visible = bB
    With Me("lab" & i)
      .Visible = bB
      Select Case Weekday(dt, vbSaturday)
        Case 1: .BackColor = RGB(224, 224, 255)
        Case 2: .BackColor = RGB(255, 224, 224)
        Case Else: .BackColor = RGB(255, 255, 255)
      End Select
    End With
  Next

  Me.Filter = "開始日<#" & DateSerial(Me.cbx1, Me.cbx2 + 1, 1) & "# AND " _
        & "完了日>=#" & DateSerial(Me.cbx1, Me.cbx2, 1) & "#"
  Me.FilterOn = True
End Function

Private Sub cb1_Click()
  Me.Painting = False ' 回答した時はなかったもの(描画を止めてみた)
  Me.Recalc
  Me.Painting = True ' 回答した時はなかったもの(描画を止めてみた)
End Sub

Private Sub Form_Load()
  Dim dt As Date
  Dim i As Integer, sS As String

  dt = Date
  Me.cb1 = True
  With Me.cbx1
    .ValidationRule = "Is Not Null"
    .Value = 2013
'    .Value = Year(dt) ' 回答した時はこっち(サンプルデータが後からでも見易い様に)
    .AfterUpdate = "=DayChange()"
  End With
  With Me.cbx2
    .ValidationRule = "Is Not Null"
    .Value = 3
'    .Value = Month(dt) ' 回答した時はこっち(サンプルデータが後からでも見易い様に)
    .AfterUpdate = "=DayChange()"
  End With
  Call DayChange

  For i = 1 To 31
    sS = "DayCheck([開始日], [完了日], " & i & ")"
    With Me("a" & i).FormatConditions
      .Delete
      With .Add(acExpression, , sS & "=1")
        .BackColor = RGB(255, 224, 224)
      End With
      With .Add(acExpression, , sS & "=2")
        .BackColor = RGB(224, 255, 224)
      End With
    End With
  Next
End Sub

 
条件付き書式を複数設定した場合、条件に一致するものがあったら、それ以降は実行されない・・・
日曜日の判定を先にした理由です。
追記 4/2 判定を逆にした方が速くなるかも・・・・

動きとして、
年、月 を変更すると、その暦通りの表示に変更します。
28 日までなら、29 ~ 31 部分は非表示に・・・・
で、その表示期間にあるデータを表示する様に Filter 操作します。

表示後、月 部分を 1 ~ 4 に変更してみてください。


フォーム「F_T19改」(補足後のもの)

実際には、フォーム「F_T19元」をコピーして、コンボ「cbx1」「cbx2」を削除したものになります。
kEnt153_12
テキストボックス「a1」~「a31」の各 Tag に、自分が担当する日付を設定します。
この日付は、レコードが移動するたびに設定されます。
日曜表示除外の場合は、日曜日を除外しつつ 31日分を割り当てていきます。
同様に、日にち表示のラベル部分も変更していきます。

記述を変更したものは以下
Private Function DayCheck(vDtS As Variant, vDtE As Variant, iNum As Integer) As Boolean
  Dim dt As Date

  On Error Resume Next
  DayCheck = False
  dt = CDate(Me("a" & iNum).Tag)
  DayCheck = (vDtS <= dt) And (dt <= vDtE)
End Function

Private Sub cb1_Click()
  Dim dt As Date
  Dim i As Integer, j As Integer

  If (Me.NewRecord) Then Exit Sub
  Me.Painting = False
  dt = Nz(Me.開始日, Date)
  i = 1
  While (i <= 31)
    j = Weekday(dt, vbSunday)
    If ((j <> 1) Or (Not Me.cb1)) Then
      With Me("lab" & i)
        .Caption = Day(dt)
        Select Case j
          Case 1: .BackColor = RGB(255, 224, 224)
          Case 7: .BackColor = RGB(224, 224, 255)
          Case Else: .BackColor = RGB(255, 255, 255)
        End Select
      End With
      Me("a" & i).Tag = dt
      i = i + 1
    End If
    dt = dt + 1
  Wend
  Me.Recalc
  Me.Painting = True
End Sub

Private Sub Form_Current()
  Call cb1_Click
End Sub

Private Sub Form_Load()
  Dim i As Integer, sS As String

  Me.cb1 = False
  For i = 1 To 31
    sS = "=IIF(DayCheck([開始日], [完了日], " & i & "),'g',Null)"
    With Me("a" & i)
      .FontName = "Webdings"
      .FontSize = 20
      .ForeColor = RGB(224, 255, 224)
      .ControlSource = sS
    End With
  Next
End Sub

 
表示後、各レコードに移動してみてください。
そのレコードの「開始日」を基準に、表示が変更されると思います。

※ これには、大きな欠点(?)があって・・・
  新規行に移った場合、日にち部分は動かないようにしているので、表示するデータが1件もなかった場合、
  データを新規追加しても、そのデータに移動しないと日にち部分が書き変わらない。
  そういうものだ・・・・とすれば、それはそれで・・・

総括して、

・初期の回答では、条件付き書式を使って、除外のところは別の色を・・・
・補足後の回答では、コントロールソースで・・・
 これは、文字を表示する/しないで・・・文字の色を見せる・・・
 過去にも記事にしてたかな・・・・重ねる

1色を使って・・・なら、どちらの方法もありだと思います。
条件付き書式の場合は、日曜日か・・・の判別条件を削除するだけで・・・・変更はチョイですね。
まぁ、大きな違いとすれば、条件付き書式の方はチョッと気を使うかな・・・・

というのは、フォーム「F_T19元」で確認して頂ければわかると思うのですが、
色を付けるだけなので、「編集ロック:はい」「使用可能:いいえ」に設定していました。
条件付き書式によって色が変わった部分をマウスクリックすると・・・・・
そう・・・フォーカスが入ってしまいます。
フォーカスが入ったからといって、何かを入力できるわけではないのですけど・・・
色が付いていない部分、色が付いている部分、それぞれクリックしてみて・・・・
基本フォームを作る処理内で、「タブストップ:いいえ」を設定していたので、
Enter キー / Tab キー での動作に変わりはありませんでしたが・・・・
「タブストップ:はい」になっていると・・・・・う~~

ま、条件付き書式によって、背景色・文字の色・・・等、複数変更したい時には仕方がない(?)
フォーカスを入れたくなければ、上側に透明のラベル等を配置する・・・・でも良いかも・・・
もちろん、「タブストップ:いいえ」で・・・・


サンプルは以下
 バージョン 20002003 (2002)2007
 ファイル kEnt153_2000.zipkEnt153_2003.zipkEnt153_2007.zip
 サイズ 36,27540,62542,882
※ ファイルは zip 形式
※ 2007 以外は、2007 保存時に変換 & 各バージョンで動作確認 & 最適化

関連記事

2013/03/30

Category: サンプルかな

TB: --  /  CM: 0

top △

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

top △

コメントの投稿

Secret

top △


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