Access VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
85 / 500 ﾍﾟｰｼﾞ ←次へ　｜　前へ→
【11604】Re:MDBの分離　と　レコード操作
質問  pon  - 10/4/12(月) 18:16 -
引用なし
パスワード
   247b さん　ありがとうございます


>Q１
>でトランザクションを仕掛けられます。
申し訳ないですが
こちらについては排他処理が完了してから試してみたいと思います
（取りあえず、追加クエリの発行で動作しますので）


>Q３
>最新状態を表示するシステム上の必要性がある場合は、上記のようなフォームのプロパティで更新をコントロールしたほうが良いと思います。

についてなんですが
Set RS = DB.OpenRecordset(strSql, dbOpenSnapshot)
Set RS = DB.OpenRecordset(strSql, dbOpenDynaset)
どちらも
forms("メインフォーム").Controls("サブフォーム").requery
で、更新データを表示することは出来ました
これを
タイマー等で動作させる
という理解でよろしいでしょうか


お詫び

Private Sub Test2()
では、排他チェックが出来ていませんでした
色々試している内に、出来ているのかと錯覚してしまいました

また、希望の操作は
>Ｑ3　Test2のサーバーＭＤＢにレコード追加する　APP1_DT更新.MDBは
>　　　１人しか使用しません
でなくて
複数のAPP.MDBからDT.MDBを編集したい
となりました

APP.MDBから
DT.MDBを編集時のみ、排他で開いて、直ぐ閉じる
DT.MDBを開きに行って排他だったら、少し待機し再チャレンジ
みたいにすれば可能かなと思っています　
こんなことが出来るが自信がありませんが・・・

取りあえず、
サーバー上のDT.MDBが排他状態か取得してみようと下記試しましたが
うまく出来ません

アドバイスよろしくお願いいたします

MSの
[AC97]排他的に開かれたデータベースかどうかを判定する方法
tp://support.microsoft.com/default.aspx?scid=kb;ja;117539
を試してみました

'戻り値:データベースが排他モードで開かれている場合 = -1
'　　　 データベースが共有モードで開かれている場合 = 0

Option Explicit

Declare Function SetCurrentDirectory Lib "Kernel32" Alias _
　　　　"SetCurrentDirectoryA" (ByVal lopathname As String) As Long

Public Function IsCurDBExclusive2(tg_f As String) As Integer
　　Dim db As Database
　　Dim hFile As Integer
　　hFile = FreeFile
　　
　　'カレントドライブ移動　下記2行、api宣言　途中追加
　　SetCurrentDirectory Left(tg_f, InStrRev(tg_f, "\") - 1)
　　Debug.Print CurDir
　　
　　Set db = DBEngine.Workspaces(0).Databases(0)
　　'If Dir$(db.Name) <> "" Then
　　If Dir$(tg_f) <> "" Then

　　 On Error Resume Next
　　　　Open tg_f For Binary Access Read Write Shared As hFile

　　　　Select Case Err.Number
　　　　　　Case 0
　　　　　　　　IsCurDBExclusive2 = 0　 'False
　　　　　　　　Debug.Print "0 共有モード"
　　　　　　　　
　　　　　　Case 70
　　　　　　　　IsCurDBExclusive2 = -1　'True
　　　　　　　　Debug.Print "-1 排他モード"
　　　　　　　　
　　　　　　Case Else
　　　　　　　　IsCurDBExclusive2 = Err.Number
　　　　　　　　Debug.Print Err.Number & "" & Err.Description
　　　　　　　　
　　　　End Select

　　　　Close hFile
　　　　On Error GoTo 0
　　Else
　　　　　'MsgBox db.Name & "は、見つかりません。"
　　　　　Debug.Print tg_f & "は、見つかりません。"
　　　　　
　　End If
End Function

下記では、デイレクトリ移動はしていません（↓以下で　ドライブ移動追加）
自pcで開いているMDBでは
call IsCurDBExclusive2("C:\cp2\2010\201003\LDB Viewer Form\PJ_DT.mdb")
0 共有モード　/PJ_DT.mdbを閉じている特
-1 排他モード　/PJ_DT.mdbを開いている特
C:\cp2\2010\201003\LDB Viewer Form\PJ_DT2.mdbは、見つかりません。　/無いファイル指定時
と動作できましたが

ファイルサーバー上のMDBを開いてテストすると
call IsCurDBExclusive2("\\sv\test02_リンク無\PJ_DT.mdb")
0 共有モード　/PJ_DT.mdbを閉じている特
0 共有モード　/PJ_DT.mdbを開いている特
\\Tar-fs-dfs\dfs\083見積部共同作業\方針シート\test02_リンク無\PJ_DT2.mdbは、見つかりません。
で
排他モードが取得できていません


↓以下で　ドライブ移動追加
接続先がネットワークということで
　　'カレントドライブ移動　ファイルのパス取得して引数にしています
　　SetCurrentDirectory Left(tg_f, InStrRev(tg_f, "\") - 1)
をしてみましたが
call IsCurDBExclusive2("\\sv\PJ_DT.mdb")
\\sv
0 共有モード
となってしまいます

もう一度時PCでPJ_DT.mdbを開いて試すと
call IsCurDBExclusive2("C:\cp2\2010\201003\LDB Viewer Form\PJ_DT.mdb")
C:\cp2\2010\201003\LDB Viewer Form
0 共有モード
となってしまいました　？？
Open tg_f　の指定はあっていると思うのですが・・・・

ちなみに
このAPP.MDBはマイドキュメントにあります
どうすれば、ファイルサーバー上のMDBが排他で開いているか判定できるでしょうか

わかり難いと思いますがよろしくお願いいたします
・ツリー全体表示
【11603】Re:MDBの分離　と　レコード操作
発言  247b  - 10/4/12(月) 10:16 -
引用なし
パスワード
   こんにちは。

Q１
事例に該当するか分かりませんが、トランザクションを仕掛けてみてはどうでしょうか。
dbs.Executeの前に、WorkSpaces(0).BeginTrans
後にWorkSpaces(0).CommitTrans
エラー処理にWorkSpaces(0).Rollback
でトランザクションを仕掛けられます。

Q３
フォームのプロパティウィンドウの、「データ」タブに、
更新の許可
削除の許可
追加の許可
などのプロパティがありますので、これらを「いいえ」にすれば、ユーザーは参照できても更新できないはずです。

プログラムソースでは、スナップショット型のレコードセットを使用しているようですが、うろ覚えですが、スナップショット型は、レコードセットをオープンしたときのデータを保持するので、その後の最新状態を参照できない問題が起こりえると思います。
最新状態を表示するシステム上の必要性がある場合は、上記のようなフォームのプロパティで更新をコントロールしたほうが良いと思います。
・ツリー全体表示
【11602】Re:MDBの分離　と　レコード操作
発言  pon  - 10/4/9(金) 15:40 -
引用なし
パスワード
   途中報告です

>Ｑ2　
>追加クエリを
>　　　　　　Application.Echo False
>　　　　　　DoCmd.OpenQuery "追加クエリ1"
>　　　　　　Application.Echo True
>としているのですが
>レコード追加の警告が出てしまいます
>どうせれば出なくなりますか

　　　　　　DoCmd.SetWarnings False
　　　　　　DoCmd.OpenQuery "追加クエリ1"
　　　　　　DoCmd.SetWarnings True

で、警告だけは抑えることが出来ました
・ツリー全体表示
【11601】MDBの分離　と　レコード操作
質問  pon  - 10/4/9(金) 15:26 -
引用なし
パスワード
   こんにちは　よろしくお願いいたします

サーバーにDT.MDB
ローカルPC　1人だけに、APP1_DT更新.MDB
ローカルPC　10人程度に、APP2_参照.MDB
で運用したいと思っています


Ｑ１
下記コード（APP1_DT更新.MDB）で、
追加のみ　dbs.Execute "INSERT INTO
がエラーは出ないのですが、レコード追加できません　
注）追加クエリの実行は出来ています
どうしたらよいでしょうか

上記は
ローカルのテーブルのレコードをサーバーに追加しています


Private Sub Test2()

　　Dim dbs As DAO.Database
　　Dim RT As Recordset
　　
　　 On Error Resume Next
　　 'Set dbs = OpenDatabase("F:\db1.mdb")
　　 'Set dbs = OpenDatabase(LC_get_path, True, False)
　　 'Set dbs = OpenDatabase(LC_get_path, True)
　　 Set dbs = OpenDatabase(LC_get_path, Options:=True)
　　
　　
　　 Select Case Err.Number
　　
　　　　'エラーなし
　　　　Case 0
　　　　　　
　　　　　　Set RT = dbs.OpenRecordset("DT02_PJ_DT", dbOpenTable)
　　　　　　
　　　　　　'追加1
　　　　　　'下記成功
　　　　　　'RT.AddNew
　　　　　　'　 RT![id] = "999777"
　　　　　　'RT.Update
　　　　　　'RT.Close
　　　　　　
　　　　　　
　　　　　　'追加2
　　　　　　'INSERT INTO DT02_PJ_DT IN '\\sv\PJ_DT.mdb' SELECT TmpT_PJ_DT.* FROM TmpT_PJ_DT;
　　　　　　'dbs.Execute "DELETE DT02_PJ_DT.*, DT02_PJ_DT.id FROM DT02_PJ_DT IN '\\sv\PJ_DT.mdb' WHERE DT02_PJ_DT.id="1132002"; INSERT INTO Customers SELECT * FROM [New Customers];"
　　　　　　'追加クエリはOKだが下記はSCCESSだが実際は駄目　←Ｑ１
　　　　　　'dbs.Execute "INSERT INTO DT02_PJ_DT IN '\\sv\PJ_DT.mdb' SELECT TmpT_PJ_DT.* FROM TmpT_PJ_DT;"
　　　　　　'仕方がないので　追加したが　警告ダイアログがでる
　　　　　　Application.Echo False
　　　　　　DoCmd.OpenQuery "追加クエリ1"
　　　　　　Application.Echo True
　　　　　　
　　　　　　'レコード削除
　　　　　　'DELETE DT02_PJ_DT.*, DT02_PJ_DT.id FROM DT02_PJ_DT IN '\\sv\PJ_DT.mdb' WHERE DT02_PJ_DT.id="1132002";
　　　　　　'下記成功
　　　　　　'dbs.Execute "DELETE DT02_PJ_DT.*, DT02_PJ_DT.id FROM DT02_PJ_DT IN '\\sv\PJ_DT.mdb' WHERE DT02_PJ_DT.id='1132003';"


　　　　　　Debug.Print "success"
　　　　
　　　　'排他モードで開かれていた場合
　　　　 Case 3045
　　　　　　 'MsgBox Err.Description
　　　　　　 Debug.Print Err.Description
　　　　　　
　　　　　　 GoTo ExitProc
　　　　　　
　　　　'その他のエラー
　　　　 Case Else
　　　　　　 'MsgBox Err.Description
　　　　　　 Debug.Print Err.Description
　　　　　　
　　　　　　 GoTo ExitProc
　　 End Select
　　 On Error GoTo 0
　　
ExitProc:
　　
　　dbs.Close

　　Set dbs = Nothing

End Sub


Ｑ2　
追加クエリを
　　　　　　Application.Echo False
　　　　　　DoCmd.OpenQuery "追加クエリ1"
　　　　　　Application.Echo True
としているのですが
レコード追加の警告が出てしまいます
どうせれば出なくなりますか


Ｑ3　Test2のサーバーＭＤＢにレコード追加する　APP1_DT更新.MDBは
　　　１人しか使用しません
　　APP2_参照.MDBでは、リンクテーブルではなく
　　フォームのレコードソースに
　　DB.OpenRecordset(strSql, dbOpenSnapshot)
　　で参照のみでの使用となっています
　　
　　このような運用であれば、破損の心配は無いような気もしますが
　　どうなんでしょう
　　注意点等あればアドバイスよろしくお願いいたします
・ツリー全体表示
【11600】Re:ＡｃｔｉｖｅＸコントロールへのセッ...
質問  こじこじ  - 10/4/9(金) 9:42 -
引用なし
パスワード
   返信ありがとうございます。

ＶＢＡでは、セットは出来ないと言う事ですね。

テーブルにリンクとは、
レコードソースにテーブル（クエリー）をセットして
コントロールソースにフィールドをセットすると言うことですか？

この方法は使えませんので、ＡｃｔｉｖｅＸコントロールでの
バーコードは使用出来ないようですね
・ツリー全体表示
【11599】Re:ＡｃｔｉｖｅＸコントロールへのセッ...
回答  よろずや  - 10/4/8(木) 20:58 -
引用なし
パスワード
   >ActiveXコントロールは、
>「Microsoft バーコード コントロール 9.0」を使用しております。

値をセットすることは出来ません。
テーブル（クエリ）にリンクさせて下さい。
・ツリー全体表示
【11598】Re:ADOによるオラクルＤＢ接続についての...
お礼  VBA初心者  - 10/4/8(木) 13:22 -
引用なし
パスワード
   お世話になっております。
　回答遅れて申し訳ないです。

>[11390] でお答えしたVBA初心者さんと同じ方でしょうか。
　そうです。いろいろお世話になります。

>> 1.Accessのメニューフォームを開いたときに、オラクルサーバに接続
>>　
>> 2.次のフォームを開きコマンドを実行して「Select文」などを実行
>>
>> 3.mdbを閉じたら、オラクルサーバから抜ける（閉じる）

　上記の事柄を重点的に開発していきたいと思います。
今後とも何かとお世話になるかもしれませんが、よろしくお願いします。


▼小僧 さん：
>ＶＢＡ初心者さん：
>こんにちは。
>
>Oracleの知識はありませんのでご勘弁を…。
>
>
>> 1.Accessのメニューフォームを開いたときに、オラクルサーバに接続
>>　
>> 2.次のフォームを開きコマンドを実行して「Select文」などを実行
>>
>> 3.mdbを閉じたら、オラクルサーバから抜ける（閉じる）
>
>基本的な設計についてですが
>VBAとしては一般論としては余り望ましいものではありません。
>
>（あくまで一般論ですので、
>　目的に沿っている場合は例外もありだと思われます。
>　h tp://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=11120;id=access
>　(こちらの掲示板は直リンクが禁止ですので、補完して下さい)
>　の投稿の前半部をお読みになって下さい。）
>
>
>> 実際にちゃんとオラクルＤＢに接続されているのかを確認できなく
>> 困っております。
>
>[11390] でお答えしたVBA初心者さんと同じ方でしょうか。
>
>回答の下部に記載しましたが
>デバッグのやり方を覚えて頂くと
>ご自分で確認できますね。
>
>「VBA」「ステップ実行」「ローカルウィンドウ」等をキーワードに
>Web検索すると、色々やり方が見つかるかと思われます。


▼小僧 さん：
>ＶＢＡ初心者さん：
>こんにちは。
>
>Oracleの知識はありませんのでご勘弁を…。
>
>
>> 1.Accessのメニューフォームを開いたときに、オラクルサーバに接続
>>　
>> 2.次のフォームを開きコマンドを実行して「Select文」などを実行
>>
>> 3.mdbを閉じたら、オラクルサーバから抜ける（閉じる）
>
>基本的な設計についてですが
>VBAとしては一般論としては余り望ましいものではありません。
>
>（あくまで一般論ですので、
>　目的に沿っている場合は例外もありだと思われます。
>　h tp://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=11120;id=access
>　(こちらの掲示板は直リンクが禁止ですので、補完して下さい)
>　の投稿の前半部をお読みになって下さい。）
>
>
>> 実際にちゃんとオラクルＤＢに接続されているのかを確認できなく
>> 困っております。
>
>[11390] でお答えしたVBA初心者さんと同じ方でしょうか。
>
>回答の下部に記載しましたが
>デバッグのやり方を覚えて頂くと
>ご自分で確認できますね。
>
>「VBA」「ステップ実行」「ローカルウィンドウ」等をキーワードに
>Web検索すると、色々やり方が見つかるかと思われます。
・ツリー全体表示
【11597】Re:フィルタ適用後のEXCEL出力時について
お礼  VBA初心者  - 10/4/8(木) 10:06 -
引用なし
パスワード
   有難うございます。

　今後とも何卒ご教授をお願い致します。
自分なりにもう少しじっくりプログラムを見て
から質問するように心がけます。

有難うございました。

▼247b さん：
>とりあえず、うまく行ったようで、なによりでした。
>結構、時間かかってしまいましたね。
>
>今回は乗りかかった船ということもあり、最後までおつきあいしましたが、
>VBA初心者さんの経験年数がどのくらいか存じ上げないので、なんとも言えない
>部分もありますが、もう少し、じっくりプログラムを見てみることをお勧めします。
>
>とはいえ、分からないのに悩み続けるのも時間の無駄です。
>また機会があったらよろしくお願いします。
・ツリー全体表示
【11596】Re:ＡｃｔｉｖｅＸコントロールへのセッ...
回答  こじこじ  - 10/4/8(木) 9:46 -
引用なし
パスワード
   ご質問ありがとうございます。

ActiveXコントロールは、
「Microsoft バーコード コントロール 9.0」を使用しております。
Accessは「2003」を使用しております。

ご確認お願い致します。
・ツリー全体表示
【11595】Re:ＡｃｔｉｖｅＸコントロールへのセッ...
発言  よろずや  - 10/4/7(水) 21:02 -
引用なし
パスワード
   ActiveXコントロールのメーカーは？
Microsoftですか？
バージョンは？
・ツリー全体表示
【11594】フォーム上のコマンドボタン
質問  Kenko  - 10/4/7(水) 16:13 -
引用なし
パスワード
   アクセス初心者です。

「カウンセリングカルテ」を
テーブルを基に
・表形式と・単票形式のフォームと
・単票形式のレポートを
作成しました。

レコードが一覧できる表形式のフォーム上に
それぞれの’ID番号’に連動した
「単票形式」のフォームとレポートに飛ばす
マクロボタンをつくりたいのですが、
単表形式の一ページ目に飛ぶ操作ボタンしかまだつくれません。

どなたか、コマンドボタンの設定方法を
教えて頂ければ嬉しいです。
初心レベルですみません。。
・ツリー全体表示
【11593】Re:フィルタ適用後のEXCEL出力時について
発言  247b  - 10/4/7(水) 15:25 -
引用なし
パスワード
   とりあえず、うまく行ったようで、なによりでした。
結構、時間かかってしまいましたね。

今回は乗りかかった船ということもあり、最後までおつきあいしましたが、
VBA初心者さんの経験年数がどのくらいか存じ上げないので、なんとも言えない
部分もありますが、もう少し、じっくりプログラムを見てみることをお勧めします。

とはいえ、分からないのに悩み続けるのも時間の無駄です。
また機会があったらよろしくお願いします。
・ツリー全体表示
【11592】Re:フィルタ適用後のEXCEL出力時について
お礼  VBA初心者  - 10/4/7(水) 14:56 -
引用なし
パスワード
   いつもお世話になります。

>前回の発言のVBA文はTEST_TABLEになっていますよね。
 はいそうです。一般的にするのに「TOHO_TABLE」から「TEST_TABLE」
にしました。混乱を招きごめんなさい。

ケース２を修正した結果正しく動作しました。

Case 2
　　　　　　
　　　　　strSQL = "select TEST_TABLE.[A]"
　　　　　　　 strSQL = strSQL & ", TEST_TABLE.[B]"
　　　　　　　 strSQL = strSQL & ", TEST_TABLE.[C]"
　　　　　　　 strSQL = strSQL & ", TEST_TABLE.[D]"
　　　　　　　 strSQL = strSQL & ", TEST_TABLE.[E]"
　　　　　　　 strSQL = strSQL & ", TEST_TABLE.[F]"
　　　　　　　 strSQL = strSQL & ", TEST_TABLE.[G]"
　　　　　　　 strSQL = strSQL & ", TEST_TABLE.[H]"
　　　　　　　 strSQL = strSQL & ", TEST_TABLE.[I]"
　　　　　　　 strSQL = strSQL & ", TEST_TABLE.[J]"
　　　　　　　 strSQL = strSQL & ", TEST_TABLE.[K]"
　　　　　　　 strSQL = strSQL & ", TEST_TABLE.[L]"
　　　　　　　 strSQL = strSQL & " from TEST_TABLE"
　　　　　　　 strSQL = strSQL & " WHERE (((TEST_TABLE.[E]) In (SELECT [E] FROM [TEST_TABLE] As Tmp GROUP BY [E] HAVING Count(*)>1 )) AND ((TEST_TABLE.E)<>''))"
　　　　　　　 strSQL = strSQL & " ORDER BY TEST_TABLE.[E] "


お忙しい中、ご対応いただき誠に有難うございました。
　今後ともよろしくお願い致します。


▼247b さん：
>おつかれさまです。
>
>コマンド36_Click()プロシージャのCase2のSQL文で、
>
>strSQL = strSQL & " WHERE (((TEST_TABLE.E In (SELECT TEST_TABLE.E FROM (SELECT COUNT(*),TEST_TABLE.E FROM TEST_TABLE As TEST_TABLE　 "
>
>の中の
>
>SELECT TEST_TABLE.E FROM (SELECT COUNT(*),TEST_TABLE.E FROM TEST_TABLE As TEST_TABLE
>
>のSQLのFROMに指定しているテーブル名が「TEST_TABLE」になっていますが。「TEST_TABLE」が正しくはないですか？
>
>前回の発言のVBA文はTEST_TABLEになっていますよね。
・ツリー全体表示
【11591】Re:フィルタ適用後のEXCEL出力時について
発言  247b  - 10/4/7(水) 14:17 -
引用なし
パスワード
   おつかれさまです。

コマンド36_Click()プロシージャのCase2のSQL文で、

strSQL = strSQL & " WHERE (((TEST_TABLE.E In (SELECT TEST_TABLE.E FROM (SELECT COUNT(*),TEST_TABLE.E FROM TEST_TABLE As TEST_TABLE　 "

の中の

SELECT TEST_TABLE.E FROM (SELECT COUNT(*),TEST_TABLE.E FROM TEST_TABLE As TEST_TABLE

のSQLのFROMに指定しているテーブル名が「TEST_TABLE」になっていますが。「TOHO_TABLE」が正しくはないですか？

前回の発言のVBA文はTOHO_TABLEになっていますよね。
・ツリー全体表示
【11590】Re:フィルタ適用後のEXCEL出力時について
回答  VBA初心者  - 10/4/7(水) 13:53 -
引用なし
パスワード
   お世話になります。

下記にソースを記述します。
　フレームで条件を抽出する場合と「コマンド38_Click」
をクリックした時の検索条件にて値を抽出するようにしてます。


お手数ですが、よろしくお願いします。　
---------------------VBAソース-------------------------------

Private Sub コマンド36_Click()----フレームの抽出条件

Me.RecordSource = frmRecSource
　　Me.Requery
　

End Sub

Function frmRecSource() As String-----Function関数
　　Dim strSQL As String
　
　　Dim strWH As String
　　
　　Select Case Me.フレーム54
　　Case 1
　　　　 strSQL = "select *　" _
　　　　　　& "from TEST_TABLE "
　　Case 2
　　　　　　
　　　　　strSQL = "select TEST_TABLE.[A]"
　　　　　　　 strSQL = strSQL & ", TEST_TABLE.[B]"
　　　　　　　 strSQL = strSQL & ", TEST_TABLE.[C]"
　　　　　　　 strSQL = strSQL & ", TEST_TABLE.[D]"
　　　　　　　 strSQL = strSQL & ", TEST_TABLE.[E]"
　　　　　　　 strSQL = strSQL & ", TEST_TABLE.[F]"
　　　　　　　 strSQL = strSQL & ", TEST_TABLE.[G]"
　　　　　　　 strSQL = strSQL & ", TEST_TABLE.[H]"
　　　　　　　 strSQL = strSQL & ", TEST_TABLE.[I]"
　　　　　　　 strSQL = strSQL & ", TEST_TABLE.[J]"
　　　　　　　 strSQL = strSQL & ", TEST_TABLE.[K]"
　　　　　　　 strSQL = strSQL & ", TEST_TABLE.[L]"
　　　　　　　 strSQL = strSQL & " from TEST_TABLE"
　　　　　　　
　　　　　　　
　　　　　　　 strSQL = strSQL & " WHERE (((TEST_TABLE.E In (SELECT TEST_TABLE.E FROM (SELECT COUNT(*),TEST_TABLE.E FROM TEST_TABLE As TEST_TABLE　 "
　　　　　　　 strSQL = strSQL & " GROUP BY TEST_TABLE.E HAVING Count(*)>1 ) AS TEST_TABLE) AND TEST_TABLE.E<>'' "
　　　　　　　 strSQL = strSQL & " ORDER BY TEST_TABLE.E DESC "
　　　　
　　End Select
　　
　　Debug.Print strSQL
　　frmRecSource = strSQL
　　
End Function


Private Sub コマンド38_Click()------検索ボタン

Dim strWH As String

　　strWH = "(A Like '*" & Me.テキスト36 & "*')" _
　　　　& " OR (B Like '*" & Me.テキスト36 & "*')" _
　　　　& " OR (C Like '*" & Me.テキスト36 & "*')" _
　　　　& " OR (D Like '*" & Me.テキスト36 & "*')" _
　　　　& " OR (E Like '*" & Me.テキスト36 & "*')" _
　　　　& " OR (F Like '*" & Me.テキスト36 & "*')" _
　　　　& " OR (G Like '*" & Me.テキスト36 & "*')" _
　　　　& " OR (H Like '*" & Me.テキスト36 & "*')" _
　　　　& " OR (I Like '*" & Me.テキスト36 & "*')"


　　Me.Filter = strWH
　　Me.FilterOn = True


Private Sub コマンド41_Click()--------------Excel出力
　　
'On Error GoTo Err_コマンド41_Click
　　
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim strWhere As String
Dim xlsApp As Object
Dim xlsWkb As Object
Dim xlsFileName As String
Dim i As Long

Dim myDir As String　'デスクトップ定数

　　'フィルタを掛けた時点で Hitするものがなかったような場合は
　　'メッセージを出して処理を中止します。
　　If Me.Recordset.EOF Then
　　　　MsgBox Prompt:="出力するデータがありませぬ" _
　　　　　　 , Buttons:=vbExclamation
　　　　Exit Sub
　　End If
　　
　　'デスクトップを指定
　　myDir = CreateObject("WScript.Shell").SpecialFolders("Desktop")

　　Set db = CurrentDb
　　xlsFileName = myDir & "\" & Format(Date, "yyyy_mm_dd") & "一覧.xls"

　　'もし Filterプロパティになにも記述されていなかったら
　　'フォームに表示されている全データを出力するようにします。
　　If Me.Filter = "" Then
　　　　strWhere = True
　　Else
　　　　strWhere = Me.Filter
　　End If

'解除ボタンを押した場合は、全データを出力するようにします。
　　If Me.FilterOn = False Then
　　　　strWhere = True
　　 End If
　
　
　　'変数に SQL文を代入します。
　　'Filter プロパティに記述されているものを抽出条件とします。


　　strSQL = ""
　　strSQL = strSQL & " SELECT C "
　　strSQL = strSQL & " , A AS 事業所名 "
　　strSQL = strSQL & " , B AS ＰＣ名 "
　　strSQL = strSQL & " , D AS セグメント名 "
　　strSQL = strSQL & " , E AS ＩＰアドレス "
　　strSQL = strSQL & " , F AS 機種 "
　　strSQL = strSQL & " , G As ドメイン名 "
　　strSQL = strSQL & " , H As 使用者 "
　　strSQL = strSQL & " , I "
　　strSQL = strSQL & " , J "
　　strSQL = strSQL & " , K "
　　strSQL = strSQL & " , L "
　　'strSQL = strSQL & " FROM " & Me.RecordSource & " "
　　strSQL = strSQL & " FROM (" & Me.RecordSource & ") As TEST_TABLE"
　　strSQL = strSQL & " WHERE " & strWhere
　　'strSQL = strSQL & " ORDER BY A DESC"　'名を降順で並べ替える
　　strSQL = strSQL & " ORDER BY TEST_TABLE.A DESC" '名を降順で並べ替える
　　
　　'レコードセットに対象のデータを代入します
　　Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot)


　　'以下Excelの操作------------------------------------------
　　Set xlsApp = CreateObject("Excel.Application")
　　　　xlsApp.Visible = True
　
　　Set xlsWkb = xlsApp.workbooks.Add
　　　　With xlsWkb.Sheets("Sheet1")

　　　　 For i = 0 To rs.Fields.Count - 1
　　　　　　 .Range("A1").Offset(0, i).Value = rs.Fields(i).Name
　　　　　　 Debug.Print rs.Fields(i).Name
　　　　 Next i
　　
　　　　.Range("A2").CopyFromRecordset rs
　　　　.columns("A:K").AutoFit
　　　　End With
　　
　　
　　xlsWkb.SaveAs xlsFileName, FileFormat:=56
　　xlsWkb.Close: Set xlsWkb = Nothing
　　xlsApp.Quit: Set xlsApp = Nothing
　
　　MsgBox "出力しました!!"

　　
Exit_コマンド41_Click:
　　Exit Sub

Err_コマンド41_Click:
　　MsgBox "出力できません！管理者に確認！！"
　　Resume Exit_コマンド41_Click
　　
　　
End Sub


▼247b さん：
>最新のVBAプログラムを見せてください。
・ツリー全体表示
【11589】Re:フィルタ適用後のEXCEL出力時について
発言  247b  - 10/4/7(水) 13:00 -
引用なし
パスワード
   最新のVBAプログラムを見せてください。
・ツリー全体表示
【11588】ＡｃｔｉｖｅＸコントロールへのセット方...
質問  こじこじ  - 10/4/7(水) 11:59 -
引用なし
パスワード
   お世話になっております。
こじこじです。

あるレポートを作成しております。
バーコードを印字する為に、ＡｃｔｉｖｅＸコントロールにて、
バーコード枠をセットしております。
レポートのレコードソースは、設定せず、
印刷時のＶＢＡにて、各テキストボックスにデータをセットしております。
そこで問題なのですが、
ＡｃｔｉｖｅＸコントロールで追加しているバーコード枠に関して、
データをセットしようとするとエラーが発生してしまいます。
（実行時エラー：2101　プロパティの設定値として指定した値が正しくありません）

どのようにすればセット出来るのでしょうか。

（レポートイメージ）
「txt郵便番号」（テキストボックス）
「txt住所」（テキストボックス）
「txt名前」（テキストボックス）
「txtバーコード」（ActiveXコントロール）

（詳細_Printのソール）
ＤＡＯにて
　　Dim mydb　　　　As Database
　　Dim myRecset　　As Recordset
　　Set mydb = CurrentDb
　　Set myRecset = mydb.OpenRecordset("テーブルＡ")

　　Me![txt郵便番号] = myRecset![郵便番号]
　　Me![txt住所] = myRecset![住所]
　　Me![txt名前] = myRecset![名前]
　　Me![txtバーコード] = myRecset![カスタマーバーコード]


Me![txtバーコード] = myRecset![カスタマーバーコード]　の部分でエラーと
なってしまいます。

どうぞよろしくお願いします。
・ツリー全体表示
【11587】Re:フィルタ適用後のEXCEL出力時について
質問  VBA初心者  - 10/4/7(水) 11:13 -
引用なし
パスワード
   お世話様です。

ACCESSSのバージョンは2007です。

>SQLをVBAに埋め込む際ににミスってたりしませんか？

--------------ＶＢＡ----------------------------------------------
TOHO_TABLE.E In
(SELECT tmp2.E FROM
(SELECT COUNT(*),Tmp.E FROM TOHO_TABLE As Tmp　
GROUP BY Tmp.E HAVING Count(*)>1) AS Tmp2)
AND TOHO_TABLE.E<>''
ORDER BY TOHO_TABLE.E DESC
--------------------------------------------------------------------
のソースを記述しました。
お忙しい中恐縮ですが、よろしくお願いします。

▼247b さん：
>また、ACCESSSのバージョンは何ですか？　Access2000だとSQLが動かない可能性があります。
>こちらの検証環境は2003です。
>
>こちらの環境ではエラーが発生しないことを確認しています。
>このため、「演算子がありません」というエラーも出ていません。
>SQLをVBAに埋め込む際ににミスってたりしませんか？
・ツリー全体表示
【11586】Re:フィルタ適用後のEXCEL出力時について
発言  247b  - 10/4/6(火) 18:53 -
引用なし
パスワード
   また、ACCESSSのバージョンは何ですか？　Access2000だとSQLが動かない可能性があります。
こちらの検証環境は2003です。

こちらの環境ではエラーが発生しないことを確認しています。
このため、「演算子がありません」というエラーも出ていません。
SQLをVBAに埋め込む際ににミスってたりしませんか？
・ツリー全体表示
【11585】Re:フィルタ適用後のEXCEL出力時について
質問  VBA初心者  - 10/4/6(火) 18:16 -
引用なし
パスワード
   いつもお世話になります。
　下記の
>コマンド36_Click　のCase2のSQLですが、以下のもので置き換え可能ですか？
>問題ない場合、これを使ってプログラム実行してみてください
を試してみましたが、下記の場所にて「演算子がありません。」とエラー表示
されてしまいます。

--------------ＶＢＡ----------------------------------------------
TOHO_TABLE.E In
(SELECT tmp2.E FROM
(SELECT COUNT(*),Tmp.E FROM TOHO_TABLE As Tmp　
GROUP BY Tmp.E HAVING Count(*)>1) AS Tmp2)
AND TOHO_TABLE.E<>''
ORDER BY TOHO_TABLE.E DESC
--------------------------------------------------------------------
上記の条件を外すとエラーは表示されなですが。欲しいデータが取れません。
　誠に申し訳ないですが、よろしくお願いします。
　
▼247b さん：
>机上デバッグでは埒があかないので、カラム名を同じにしたテーブルを使用してSQLを作りました。
>あまり良い例ではありませんが、動作は確認しています。問題は欲しいデータが取れるかどうかなので、確認してください。
>
>コマンド36_Click　のCase2のSQLですが、以下のもので置き換え可能ですか？
>問題ない場合、これを使ってプログラム実行してみてください
>
>select TOHO_TABLE.[COMM]
>,TOHO_TABLE.[A]
>,TOHO_TABLE.[C]
>,TOHO_TABLE.[G]
>,TOHO_TABLE.[D]
>,TOHO_TABLE.[E]
>,TOHO_TABLE.[F]
>,TOHO_TABLE.[H]
>,TOHO_TABLE.[コメント]
>,TOHO_TABLE.[I]
>,TOHO_TABLE.[J]
>,TOHO_TABLE.[K]
>from TOHO_TABLE
>WHERE
> TOHO_TABLE.E In
>　(SELECT tmp2.E FROM
>　 (SELECT COUNT(*),Tmp.E FROM TOHO_TABLE As Tmp　
>　　GROUP BY Tmp.E HAVING Count(*)>1) AS Tmp2)
> AND TOHO_TABLE.E<>''
>ORDER BY TOHO_TABLE.E DESC
>
>
>コマンド41_Click　のSQLも上記SQLを使って試した版を記載しておきます。
>SELECT
>TEST_TABLE.A,
>TEST_TABLE.COMM AS テスト,
>TEST_TABLE.C AS 名Ａ,
>TEST_TABLE.D AS 名Ｂ,
>TEST_TABLE.E AS アドレス,
>TEST_TABLE.F AS 機会番号,
>TEST_TABLE.G AS 名Ｃ,
>TEST_TABLE.H AS 使用者,
>TEST_TABLE.コメント,
>TEST_TABLE.I,
>TEST_TABLE.J,
>TEST_TABLE.K
>FROM (select TOHO_TABLE.[COMM]
>,TOHO_TABLE.[A]
>,TOHO_TABLE.[C]
>,TOHO_TABLE.[G]
>,TOHO_TABLE.[D]
>,TOHO_TABLE.[E]
>,TOHO_TABLE.[F]
>,TOHO_TABLE.[H]
>,TOHO_TABLE.[コメント]
>,TOHO_TABLE.[I]
>,TOHO_TABLE.[J]
>,TOHO_TABLE.[K]
>from TOHO_TABLE
>WHERE
> TOHO_TABLE.E IN
>　(SELECT tmp2.E FROM
>　 (SELECT COUNT(*),Tmp.E FROM TOHO_TABLE As Tmp　
>　　GROUP BY Tmp.E HAVING Count(*)>1) AS Tmp2)
> AND TOHO_TABLE.E<>''
>ORDER BY TOHO_TABLE.E DESC
> ) AS TEST_TABLE
>WHERE True
>ORDER BY TOHO_TABLE.E DESC
・ツリー全体表示
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
85 / 500 ﾍﾟｰｼﾞ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
1082660
(SS)C-BOARD v3.8 is Free