Access VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


1463 / 2272 ツリー ←次へ | 前へ→

【7034】フォームからテーブル操作について inu 06/1/6(金) 15:25 質問[未読]
【7043】Re:フォームからテーブル操作について 小僧 06/1/10(火) 10:57 発言[未読]
【7044】Re:フォームからテーブル操作について 小僧 06/1/10(火) 11:09 回答[未読]
【7046】Re:フォームからテーブル操作について inu 06/1/10(火) 15:51 お礼[未読]
【7050】Re:フォームからテーブル操作について inu 06/1/11(水) 9:48 質問[未読]
【7058】Re:フォームからテーブル操作について 小僧 06/1/11(水) 11:55 発言[未読]

【7034】フォームからテーブル操作について
質問  inu  - 06/1/6(金) 15:25 -

引用なし
パスワード
   いつもお世話になっております。inuと申します。
フォームのコントロールからテーブルを操作する方法について
教えて頂きたく書き込みをしました。

以下のコードとデザインは検索結果をリストボックスに表示さ
せるというものです。(VBA初心者なものでコードの書き方は
むちゃくちゃかと思いますが、なにか効率の良い書き方があれ
ばアドバイスして頂けると幸いです)

---

Option Compare Database

Private Sub B_DocSearch_Click() '検索ボタン
On Error GoTo Err_B_DocSearch_Click

Dim tmp As String
Dim sql As String

Mgt.Value = Nz(Me!Mgt.Value)
If (Mgt.Value <> "") Then
tmp = " AND " & "文書管理台帳.文書管理番号='" & Mgt.Value & "'"
End If
Namea.Value = Nz(Me!Namea.Value)
If (Namea.Value <> "") Then
tmp = tmp & " AND " & "文書管理台帳.文書名='" & Namea.Value & "'"
End If
RevNum.Value = Nz(Me!RevNum.Value)
If (RevNum.Value <> "") Then
tmp = tmp & " AND " & "文書管理台帳.版番='" & RevNum.Value & "'"
End If
If (Make.Value <> "") Then
tmp = tmp & " AND " & "文書管理台帳.作成者='" & Make.Value & "'"
End If
Ena.Value = Nz(Me!Ena.Value)
If (Ena.Value <> "") Then
tmp = tmp & " AND " & "文書管理台帳.制定日='" & Ena.Value & "'"
End If
Last.Value = Nz(Me!Last.Value)
If (Last.Value <> "") Then
tmp = tmp & " AND " & "文書管理台帳.最終更新者='" & Last.Value & "'"
End If
LastDate.Value = Nz(Me!LastDate.Value)
If (LastDate.Value <> "") Then
tmp = tmp & " AND " & "文書管理台帳.最終更新日='" & LastDate.Value & "'"
End If
Term.Value = Nz(Me!Term.Value)
If (Term.Value <> "") Then
tmp = tmp & " AND " & "文書管理台帳.有効期限='" & Term.Value & "'"
End If
Abo.Value = Nz(Me!Abo.Value)
If (Abo.Value <> "") Then
tmp = tmp & " AND " & "文書管理台帳.廃止文書='" & Abo.Value & "'"
End If
AboDate.Value = Nz(Me!AboDate.Value)
If (AboDate.Value <> "") Then
tmp = tmp & " AND " & "文書管理台帳.廃止日='" & AboDate.Value & "'"
End If

sql = Mid(tmp, 6)

If (Me.フレーム38.Value = 1) Then
If (sql = "") Then Exit Sub
Call MakeQuery(sql)
DoCmd.DeleteObject acQuery, "Q_Tmp"
リスト0.RowSource = "Q_DocSearchOR"

Else
If (sql = "") Then Exit Sub
Call MakeQuery(sql)

リスト0.RowSource = "Q_Tmp"
DoCmd.DeleteObject acQuery, "Q_Tmp"


End If

Exit_B_DocSearch_Click:
  Exit Sub

Err_B_DocSearch_Click:
  MsgBox Err.Description
  Resume Exit_B_DocSearch_Click
  

End Sub
Private Sub B_FormExit_Click() '終了ボタン
On Error GoTo Err_B_FormExit_Click


  DoCmd.Close

Exit_B_FormExit_Click:
  Exit Sub

Err_B_FormExit_Click:
  MsgBox Err.Description
  Resume Exit_B_FormExit_Click
  
End Sub

Public Sub MakeQuery(tmp2 As String) 'リストボックスに表示する検索結果のクエリ
     Dim CAT As ADOX.Catalog
     Dim CMD As ADODB.Command
     Dim CAT2 As ADOX.Catalog
     Dim CMD2 As ADODB.Command
  
     '接続
     Set CAT = New ADOX.Catalog
     CAT.ActiveConnection = CurrentProject.Connection
     Set CAT2 = New ADOX.Catalog
     CAT2.ActiveConnection = CurrentProject.Connection
  
     'クエリの定義
     Set CMD = New ADODB.Command
     CMD.CommandText = "SELECT * FROM 文書管理台帳 WHERE " & tmp2
     Set CMD2 = New ADODB.Command
     CMD2.CommandText = "SELECT * FROM 文書管理台帳 WHERE " & tmp2

     'クエリ作成
     CAT.Views.Append "Q_Tmp", CMD
     If (CAT2.Views.Count = 2) Then
     DoCmd.DeleteObject acQuery, "Q_Rep"
     End If
     If (CAT2.Views.Count <= 1 Or 2) Then
     CAT2.Views.Append "Q_Rep", CMD2
     End If

     '終了
     Set CMD = Nothing
     Set CAT = Nothing
     Set CMD2 = Nothing
     Set CAT2 = Nothing
   End Sub

Private Sub コマンド32_Click() 'クリアボタン

Mgt.Value = ""
Namea.Value = ""
RevNum.Value = ""
Ena.Value = ""
Last.Value = ""
LastDate.Value = ""
Term.Value = ""
Abo.Value = ""
AboDate.Value = ""

リスト0.RowSource = "SELECT * FROM 文書管理台帳"

End Sub
Private Sub 印刷プレビュー_Click() '印刷プレビューボタン
On Error GoTo Err_印刷プレビュー_Click

  Dim stDocName As String

  If ((Mgt.Value = "" And Namea.Value = "" And RevNum.Value = "" And Ena.Value = "" And Last.Value = "" And LastDate.Value = "" And Term.Value = "" And Abo.Value = "" And AboDate.Value = "") Or (IsNull(Mgt.Value) And IsNull(Namea.Value) And IsNull(RevNum.Value) And IsNull(Ena.Value) And IsNull(Last.Value) And IsNull(LastDate.Value) And IsNull(Term.Value) And IsNull(Abo.Value) And IsNull(AboDate.Value))) Then
  DoCmd.OpenReport "R_null", acPreview
  Else
  stDocName = "Q_Rep"
  DoCmd.OpenReport stDocName, acPreview
  End If
Exit_印刷プレビュー_Click:
  Exit Sub

Err_印刷プレビュー_Click:
  MsgBox Err.Description
  Resume Exit_印刷プレビュー_Click
  
End Sub

デザイン画像
http://www.imgup.org/file/iup142347.jpg

---

私がやりたいのは、リストボックスに表示されているレコードを
右クリックすれば「追加」、「変更」といメニューが表示され
メニューをクリックするとダイアログが表示されレコードの追加、変更
ができるようなVBAを書きたいのですがどのようにコードを修正すれば
良いかわかりません。さらにレコードをダブルクリックすると参照先の
ファイルを開きに行くようなVBAも書きたいのですが、教えていただけ
ないでしょうか?宜しくお願いいたします。

【7043】Re:フォームからテーブル操作について
発言  小僧  - 06/1/10(火) 10:57 -

引用なし
パスワード
   ▼inu さん:
こんにちは。

まず本題の方からです。

>右クリックすれば「追加」、「変更」といメニューが表示

CommandBar オブジェクトを操作する事になると思います。
当方も扱った事がないので詳しくは回答できませんが、
Office x.x Object Library を参照設定してヘルプ等を参考にされてみて下さい。

>さらにレコードをダブルクリックすると参照先の
>ファイルを開きに行くようなVBAも書きたい

こちらは Shell関数 を用いて実現可能だと思います。

【7044】Re:フォームからテーブル操作について
回答  小僧  - 06/1/10(火) 11:09 -

引用なし
パスワード
   ▼inu さん:

>なにか効率の良い書き方があればアドバイスして頂けると幸いです

前提条件として、文書管理台帳のフィールド名が
フォームと同じ順序で並んでいる必要があります。

Option Compare Database
Option Explicit

Dim CName(1 To 10) As String
Private Sub Form_Load()
  CName(1) = "Mgt"
  CName(2) = "Namea"
  CName(3) = "RevNum"
  CName(4) = "Make"
  CName(5) = "Ena"
  CName(6) = "Last"
  CName(7) = "LastDate"
  CName(8) = "Term"
  CName(9) = "Abo"
  CName(10) = "AboDate"
  Me.フレーム38.value = 1
End Sub

'-------------------------------------------------------------------
Private Sub B_DocSearch_Click() '検索ボタン
Dim strSQL As String
Dim RS As New ADODB.Recordset
Dim X As String       'OR のオプション値が1の場合です
Dim i As Long
  
  If Me.フレーム38.value = 1 Then
    X = "OR"
  Else
    X = "AND"
  End If
   
  RS.Open "SELECT * FROM 文書管理台帳", CurrentProject.Connection
  For i = 1 To 10
    If Not IsNull(Me.Controls(CName(i))) Then
      strSQL = strSQL & " " & X & " " & _
      RS(i - 1).Name & "='" & Me.Controls(CName(i)).value & "'"
    End If
  Next
  RS.Close: Set RS = Nothing
  If strSQL = "" Then
    Me.リスト0.RowSource = "文書管理台帳"
  Else
    strSQL = Mid(strSQL, InStr(2, strSQL, " ") + 1)
    Me.リスト0.RowSource = "SELECT * FROM 文書管理台帳 WHERE " & strSQL
  End If
  Me.リスト0.Requery
End Sub

'-------------------------------------------------------------------
Private Sub B_FormExit_Click() '終了ボタン
  DoCmd.Close
End Sub

'-------------------------------------------------------------------
Private Sub コマンド32_Click() 'クリアボタン
Dim i As Long
  For i = 1 To 10
    Me.Controls(CName(i)).Value = ""
  Next

  Me.リスト0.RowSource = "SELECT * FROM 文書管理台帳"
  Me.Requery
End Sub

'-------------------------------------------------------------------
Private Sub 印刷プレビュー_Click() '印刷プレビューボタン
Dim strSource As String
Dim strWhere As String
  
  strSource = Me.リスト0.RowSource
  If InStr(1, strSource, "WHERE") = 0 Then
    strWhere = ""
  Else
    strWhere = Mid(strSource, InStr(1, strSource, "WHERE") + 6)
  End If
  Debug.Print strWhere
  DoCmd.OpenReport "R_null", acViewPreview, WhereCondition:=strWhere
End Sub


・コントロールの配列化
   コントロールに規則的な名前を持たせるとループ処理が可能です。
   今回は規則性がなかったので、FormLoad時に変数に入れてみました。

・クエリを作らない
   リストボックスの値集合ソースにはテーブル名やクエリ名だけでなく
   SQL文を直接指定できます。

・レポートは1種類で
    OpenReportメソッド の WhereCondition を利用してフィルタを掛け、
    リストボックスに表示されている情報に合わせてレポートを表示させてみました。

【7046】Re:フォームからテーブル操作について
お礼  inu  - 06/1/10(火) 15:51 -

引用なし
パスワード
   ▼小僧 さん:
>▼inu さん:
>
>>なにか効率の良い書き方があればアドバイスして頂けると幸いです
>
>前提条件として、文書管理台帳のフィールド名が
>フォームと同じ順序で並んでいる必要があります。
>
>Option Compare Database
>Option Explicit
>
>Dim CName(1 To 10) As String
>Private Sub Form_Load()
>  CName(1) = "Mgt"
>  CName(2) = "Namea"
>  CName(3) = "RevNum"
>  CName(4) = "Make"
>  CName(5) = "Ena"
>  CName(6) = "Last"
>  CName(7) = "LastDate"
>  CName(8) = "Term"
>  CName(9) = "Abo"
>  CName(10) = "AboDate"
>  Me.フレーム38.value = 1
>End Sub
>
>'-------------------------------------------------------------------
>Private Sub B_DocSearch_Click() '検索ボタン
>Dim strSQL As String
>Dim RS As New ADODB.Recordset
>Dim X As String       'OR のオプション値が1の場合です
>Dim i As Long
>  
>  If Me.フレーム38.value = 1 Then
>    X = "OR"
>  Else
>    X = "AND"
>  End If
>   
>  RS.Open "SELECT * FROM 文書管理台帳", CurrentProject.Connection
>  For i = 1 To 10
>    If Not IsNull(Me.Controls(CName(i))) Then
>      strSQL = strSQL & " " & X & " " & _
>      RS(i - 1).Name & "='" & Me.Controls(CName(i)).value & "'"
>    End If
>  Next
>  RS.Close: Set RS = Nothing
>  If strSQL = "" Then
>    Me.リスト0.RowSource = "文書管理台帳"
>  Else
>    strSQL = Mid(strSQL, InStr(2, strSQL, " ") + 1)
>    Me.リスト0.RowSource = "SELECT * FROM 文書管理台帳 WHERE " & strSQL
>  End If
>  Me.リスト0.Requery
>End Sub
>
>'-------------------------------------------------------------------
>Private Sub B_FormExit_Click() '終了ボタン
>  DoCmd.Close
>End Sub
>
>'-------------------------------------------------------------------
>Private Sub コマンド32_Click() 'クリアボタン
>Dim i As Long
>  For i = 1 To 10
>    Me.Controls(CName(i)).Value = ""
>  Next
>
>  Me.リスト0.RowSource = "SELECT * FROM 文書管理台帳"
>  Me.Requery
>End Sub
>
>'-------------------------------------------------------------------
>Private Sub 印刷プレビュー_Click() '印刷プレビューボタン
>Dim strSource As String
>Dim strWhere As String
>  
>  strSource = Me.リスト0.RowSource
>  If InStr(1, strSource, "WHERE") = 0 Then
>    strWhere = ""
>  Else
>    strWhere = Mid(strSource, InStr(1, strSource, "WHERE") + 6)
>  End If
>  Debug.Print strWhere
>  DoCmd.OpenReport "R_null", acViewPreview, WhereCondition:=strWhere
>End Sub
>
>
>・コントロールの配列化
>   コントロールに規則的な名前を持たせるとループ処理が可能です。
>   今回は規則性がなかったので、FormLoad時に変数に入れてみました。
>
>・クエリを作らない
>   リストボックスの値集合ソースにはテーブル名やクエリ名だけでなく
>   SQL文を直接指定できます。
>
>・レポートは1種類で
>    OpenReportメソッド の WhereCondition を利用してフィルタを掛け、
>    リストボックスに表示されている情報に合わせてレポートを表示させてみました。

小僧さんアドバイスありがとうございます。
小僧さんの下さったヒントを元に試してみますね。

【7050】Re:フォームからテーブル操作について
質問  inu  - 06/1/11(水) 9:48 -

引用なし
パスワード
   小僧さんありがとうございます。おかげさまで
効率の良いコードがかけました。

Shell関数についてですが
Shell("C:\xxx\xxx\xxx.doc", 1)
というので良いのでしょうか?これだとリストボックスを
ダブルクリックした時にファイルが開いてしまいます。
リストボックスに表示されているレコードをダブルクリック
した時に目的のファイルを開くようにしたいのですが
可能でしょうか?よろしくお願いします。

【7058】Re:フォームからテーブル操作について
発言  小僧  - 06/1/11(水) 11:55 -

引用なし
パスワード
   ▼inu さん:
こんにちは。

>リストボックスを>ダブルクリックした時にファイルが開いてしまいます。
>リストボックスに表示されているレコードをダブルクリック
>した時に目的のファイルを開くようにしたいのですが

ちょっと当方には意味が解りかねるのですが、
レコードが選択されていない場合は実行したくない、という事でしょうか?

もしそのようでしたら、リストボックスの ItemsSelected.Count の数を調べて
条件分岐させてみてはいかがでしょうか。

1463 / 2272 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
1078229
(SS)C-BOARD v3.8 is Free