FC2ブログ

スポンサーサイト 


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

--/--/--

Category: スポンサー広告

TB: --  /  CM: --

top △

更新できないクエリでどうにか 


テーブル「TB」が以下のようになっている時
an名前退職
1佐藤True
2田中False
3佐藤False
4高橋False
5田中True
6加藤False

クエリ「Q_TB」
SELECT 名前, Count(*) AS カウント, 退職
FROM TB
GROUP BY 名前, 退職;
と「名前」「退職」でグループ化した表示
名前カウント退職
加藤1False
高橋1False
佐藤1True
佐藤1False
田中1True
田中1False
・・・でチェックを入れたい。(このテーブルの用途がわからないのですが)

更新できないクエリになっているので「できない」となると思いますが、フォームを使えばどうにか・・・・

チェック部分をクリックした時に処理をする・・・これ、フォーム「F7」で
kEnt102

でも、やりたいことはチェックを入れたものをまとめて処理したい・・・・
っていうことなんでしょうか。

そこで、テーブル「TB」を「TA」としてコピーして、(退職=False にしておきますが)
クエリ「Q_TA」を
SELECT 名前, Count(*) AS カウント
FROM TA
WHERE 退職=False
GROUP BY 名前;
として、チェックしたものをまとめて 退職=True に変更しますか・・・・
名前カウント
加藤1
高橋1
佐藤2
田中2

この表示にチェック機能を付けていきます。
フォームの表示はほぼ同じですが、中での実現の仕方を何通りか・・・・
用意したフォームは「F1」~「F7」の7つ。

なお、実現において hatena さん紹介の方法をいろいろと組み込んでました。
ありがとうございます。
 
基本的なフォームは以下のようになってます。
kEnt102_1

前述のクエリ「Q_TA」を元に、フォームウィザードで表形式として作成します。
そこに、
「行番」表示用のテキストボックス「txt1」
チェックを入れる(実際には状態の表示用)のためのチェックボックス「cb1」
そのチェックボックスの上に透明なコマンドボタン「btn1」
チェック状態の行番保存用にヘッダにテキストボックス「txt0」(非表示)
チェック状態のクリア用にコマンドボタン「btn00」
何かの処理用のコマンドボタン「btn0」


レコードの特定方法

F1: 行番を振る 選択された行番をヘッダの非表示テキストボックス「txt0」で保持
F2: 行番を振る 選択された行番をヘッダの非表示テキストボックス「txt0」で保持
         ただし、行番の管理は Dictionary
F3: 行番を振る 行番の管理は Dictionary (Exists で切り替え)
F4: 行番を振る 行番の管理は Dictionary (Exists で切り替え)(行番は非表示)
F5: グループ化した名前を利用  管理は Dictionary (Exists で切り替え)
F6: グループ化した名前を利用  管理は Dictionary (Exists で切り替え)
F7: 特になし


チェックボックス「cb1」のコントロールソース

F1: =IIf(InStr([txt0] & ",","," & [txt1] & ",")>0,True,False)
F2: =IIf(InStr([txt0] & ",","," & [txt1] & ",")>0,True,False)
F3: =RowCbChk([txt1])
F4: =RowCbChk([txt1])
F5: =RowCbChk([名前])
F6: =RowCbChk([名前])
F7: 退職

※ [txt1] が行番を持っているテキストボックス
 「txt1」のコントロールソースは、 =RowNo()
 で、この関数の中身は、
Private Function RowNo() As Long
  With Me.RecordsetClone
    .Bookmark = Me.Bookmark
    RowNo = .AbsolutePosition + 1
  End With
End Function
このフォームのレコードソースは追加できるものになっていないし、
存在するものにしか番号を振らないので、これで十分と思います。

※ [txt0] では True 表示する行番を保持
  1行目なら、",1"
  2と3行目なら、",2,3" のように、行番の前に "," (カンマ)を付加


フォーム「F1」

VBAで記述したのは以下
Private Function RowNo() As Long
  With Me.RecordsetClone
    .Bookmark = Me.Bookmark
    RowNo = .AbsolutePosition + 1
  End With
End Function

Private Function RowName(iNum As Long) As String
  With Me.RecordsetClone
    .AbsolutePosition = iNum - 1
    RowName = .Fields("名前")
  End With
End Function

Private Sub Form_Load()
  Me.txt0 = ""
End Sub

Private Sub btn1_Click()
  If (InStr(Me.txt0 & ",", "," & Me.txt1 & ",") > 0) Then
    Me.txt0 = Replace(Me.txt0 & ",", "," & Me.txt1 & ",", ",")
  Else
    Me.txt0 = Me.txt0 & "," & Me.txt1
  End If
  Me.txt0 = Replace(Me.txt0, ",,", ",")
End Sub

Private Sub btn00_Click()
  Me.txt0 = ""
End Sub

Private Sub btn0_Click()
  Dim sAry() As String
  Dim sS As String, sSql As String
  Dim i As Integer

  sS = ""
  sAry = Split(Me.txt0, ",")
  For i = 1 To UBound(sAry)
    If (Len(sAry(i)) > 0) Then
      sS = sS & ",'" & RowName(CLng(sAry(i))) & "'"
    End If
  Next
  sS = Mid(sS, 2)
  If (Len(sS) = 0) Then Exit Sub
  If (MsgBox(sS, vbYesNo + vbQuestion, "退職へ") = vbYes) Then
    sSql = "UPDATE TA SET 退職=True " _
        & "WHERE (退職=False) AND (名前 IN (" & sS & "));"
    CurrentDb.Execute sSql
    Me.txt0 = ""
    Me.Requery
  End If
End Sub

今回の記述で工夫した点を1つ挙げるとすれば、「txt0」のクリアを
Me.txt0 = Null ではなく、Me.txt0 = "" としました。
「txt0」は直接いじられるものではないし、以降の処理で Nz(Me.txt0) が鬱陶しく・・・

ここで、「txt0」で持っているのは行番号(AbsolutePosition + 1)になります。
その行番号から「名前」を持ってきて、UPDATE する際の IN 指定に使用します。
ただ、この方法で繰り返しチェックを入れる/はずすすると、「txt0」の中で
",," の処理が鬱陶しく感じてしまいます。

そこで、行番は Dictionary で管理して、必要なものそのものだけを「txt0」に。
それが次のフォーム「F2」になります。


フォーム「F2」

VBAで記述したのは以下
Dim dic As Object

Private Function RowNo() As Long
  With Me.RecordsetClone
    .Bookmark = Me.Bookmark
    RowNo = .AbsolutePosition + 1
  End With
End Function

Private Function RowName(iNum As Long) As String
  With Me.RecordsetClone
    .AbsolutePosition = iNum - 1
    RowName = .Fields("名前")
  End With
End Function

Private Sub Form_Load()
  Set dic = CreateObject("Scripting.Dictionary")
  Me.txt0 = ""
End Sub

Private Sub Form_Close()
  Set dic = Nothing
End Sub

Private Sub btn1_Click()
  If (Me.cb1) Then
    dic.Remove Me.txt1.Value
  Else
    dic.Add Me.txt1.Value, Null
  End If
  If (dic.Count = 0) Then
    Me.txt0 = ""
  Else
    Me.txt0 = "," & Join(dic.keys, ",")
  End If
End Sub

Private Sub btn00_Click()
  dic.RemoveAll
  Me.txt0 = ""
End Sub

Private Sub btn0_Click()
  Dim vAry As Variant
  Dim sS As String, sSql As String
  Dim i As Integer

  If (dic.Count = 0) Then Exit Sub
  sS = ""
  vAry = dic.keys
  For i = 0 To UBound(vAry)
    sS = sS & ",'" & RowName(CLng(vAry(i))) & "'"
  Next
  sS = Mid(sS, 2)
  If (MsgBox(sS, vbYesNo + vbQuestion, "退職へ") = vbYes) Then
    sSql = "UPDATE TA SET 退職=True " _
        & "WHERE (退職=False) AND (名前 IN (" & sS & "));"
    CurrentDb.Execute sSql
    dic.RemoveAll
    Me.txt0 = ""
    Me.Requery
  End If
End Sub

透明なコマンドボタン「btn1」がクリックされた時点では、
Dictionary にある/ない判別は Exists を使用すると思いますが、
今回、チェックボックス「cb1」の状態で判別することに。


フォーム「F3」

kEnt102_2
せっかく Dictionary で行番を管理しているのだから、テキストボックス「txt0」をなくし、
直接 Dictionary を参照する関数を作ってみたら・・・
ということで

VBAで記述したのは以下
Dim dic As Object

Private Function RowNo() As Long
  With Me.RecordsetClone
    .Bookmark = Me.Bookmark
    RowNo = .AbsolutePosition + 1
  End With
End Function

Private Function RowName(iNum As Long) As String
  With Me.RecordsetClone
    .AbsolutePosition = iNum - 1
    RowName = .Fields("名前")
  End With
End Function

Private Function RowCbChk(iNum As Long) As Boolean
  RowCbChk = dic.exists(iNum)
End Function

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

Private Sub Form_Close()
  Set dic = Nothing
End Sub

Private Sub btn1_Click()
  If (Me.cb1) Then
    dic.Remove Me.txt1.Value
  Else
    dic.Add Me.txt1.Value, Null
  End If
  Me.Recalc
End Sub

Private Sub btn00_Click()
  dic.RemoveAll
  Me.Recalc
End Sub

Private Sub btn0_Click()
  Dim vAry As Variant
  Dim sS As String, sSql As String
  Dim i As Integer

  If (dic.Count = 0) Then Exit Sub
  sS = ""
  vAry = dic.keys
  For i = 0 To UBound(vAry)
    sS = sS & ",'" & RowName(CLng(vAry(i))) & "'"
  Next
  sS = Mid(sS, 2)
  If (MsgBox(sS, vbYesNo + vbQuestion, "退職へ") = vbYes) Then
    sSql = "UPDATE TA SET 退職=True " _
        & "WHERE (退職=False) AND (名前 IN (" & sS & "));"
    CurrentDb.Execute sSql
    dic.RemoveAll
    Me.Requery
  End If
End Sub

このチェックボックスは Dictionary にある/ないの関数をコントロールソースに。


フォーム「F4」

VBAの記述はフォーム「F3」と同じです。
画面上、行番のテキストボックスを非表示にしただけです。


フォーム「F5」

kEnt102_3
行番を求め、その番号で Dictionary 管理していましたが、
最終的には行番→名前に変換する必要がありました。
じゃ、元々の管理を名前にしておいたら・・・・ってことで、
(名前でグループ化しているので、重複は考えなくてOK・・・)

VBAで記述したのは以下
Dim dic As Object

Private Function RowCbChk(sS As String) As Boolean
  RowCbChk = dic.exists(sS)
End Function

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

Private Sub Form_Close()
  Set dic = Nothing
End Sub

Private Sub btn1_Click()
  If (Me.cb1) Then
    dic.Remove Me.名前.Value
  Else
    dic.Add Me.名前.Value, Null
  End If
  Me.Recalc
End Sub

Private Sub btn00_Click()
  dic.RemoveAll
  Me.Recalc
End Sub

Private Sub btn0_Click()
  Dim v As Variant
  Dim sS As String, sSql As String

  If (dic.Count = 0) Then Exit Sub
  sS = ""
  For Each v In dic.keys
    sS = sS & ",'" & v & "'"
  Next
  sS = Mid(sS, 2)
  If (MsgBox(sS, vbYesNo + vbQuestion, "退職へ") = vbYes) Then
    sSql = "UPDATE TA SET 退職=True " _
        & "WHERE (退職=False) AND (名前 IN (" & sS & "));"
    CurrentDb.Execute sSql
    dic.RemoveAll
    Me.Requery
  End If
End Sub

 

フォーム「F6」

ほとんど、フォーム「F5」と同じで、クリアのボタン「btn00」はいらないでしょう・・・
ってことで

VBAで記述したのは以下
Dim dic As Object

Private Function RowCbChk(sS As String) As Boolean
  RowCbChk = dic.exists(sS)
End Function

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

Private Sub Form_Close()
  Set dic = Nothing
End Sub

Private Sub btn1_Click()
  If (Me.cb1) Then
    dic.Remove Me.名前.Value
  Else
    dic.Add Me.名前.Value, Null
  End If
  Me.Recalc
End Sub

Private Sub btn0_Click()
  Dim v As Variant
  Dim sS As String, sSql As String

  If (dic.Count = 0) Then Exit Sub
  sS = ""
  For Each v In dic.keys
    sS = sS & ",'" & v & "'"
  Next
  sS = Mid(sS, 2)
  If (MsgBox(sS, vbYesNo + vbQuestion, "退職へ") = vbYes) Then
    sSql = "UPDATE TA SET 退職=True " _
        & "WHERE (退職=False) AND (名前 IN (" & sS & "));"
    CurrentDb.Execute sSql
    dic.RemoveAll
    Me.Requery
  End If
End Sub

 

フォーム「F7」

これが、大元の要求に一番近いものになります。
「名前」「退職」でグループ化したそのものを表示しておいて、
チェックボックス「cb1」をクリック(実際には透明なコマンドボタン)した時に
そのものの状態を反転するもの。
でも、反転したら Requery によって別の方でカウントされるようになるのだけど・・・
チェックしたらその名前のレコードに行くようにしておきましょうか・・・って。
このテーブルをどのように使いたいのかわかりませんが、一応できるってことで・・・

VBAで記述したのは以下
Private Sub btn1_Click()
  Dim sN As String
  Dim sSql As String
  
  Me.Painting = False
  sN = Me.名前
  sSql = "UPDATE TB SET 退職 = " & IIf(Me.cb1, "False", "True") _
      & " WHERE 退職 = " & IIf(Me.cb1, "True", "False") _
      & " AND 名前 ='" & sN & "';"
  CurrentDb.Execute sSql
  Me.Requery
  Me.Recordset.FindFirst "名前='" & sN & "'"
  Me.Painting = True
End Sub

上記では、sN = Me.名前 としていましたが、後で使うことも考えて
Private Sub btn1_Click()
  Dim sN As String
  Dim sSql As String
  
  Me.Painting = False
  sN = "'" & Me.名前 & "'"
  sSql = "UPDATE TB SET 退職 = " & IIf(Me.cb1, "False", "True") _
      & " WHERE 退職 = " & IIf(Me.cb1, "True", "False") _
      & " AND 名前 =" & sN & ";"
  CurrentDb.Execute sSql
  Me.Requery
  Me.Recordset.FindFirst "名前=" & sN
  Me.Painting = True
End Sub
でも良いと思います。
 
 
サンプルは以下
 バージョン 20002003 (2002)2007
 ファイル kEnt102_2000.zipkEnt102_2003.zipkEnt102_2007.zip
 サイズ 42,21041,80145,391
※ ファイルは zip 形式
※ 2007 以外は、2007 保存時に変換 & 各バージョンで動作確認 & 最適化

関連記事

2011/11/26

Category: サンプルかな

TB: 0  /  CM: 0

top △

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

top △

コメントの投稿

Secret

top △

トラックバック

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

top △


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