＜ＭＤＢと同フォルダのExcelファイルを開く＞
こんにちは、Ｋｅｎ３です。 前回、VB,Access,Excelなどで、 ファイルの起動場所を知る方法 をやったので、 今回は、単に応用して、 AccessのMDBと同フォルダのＥｘｃｅｌファイルを開いてみたいと思います。 前回からの復習も兼ねて、いつものように遠まわしで説明してるので、 暇な人はお付き合いを。 実行できるサンプルを http://www.ken3.org/vba/lzh/vba007.lzh からダウンロード可能にしました。使ってみてください。 /* * １.仕様、やりたいこと */ プログラムを組む前には、どんなことやりたい？ こんなこと？ など、作りたい最終結果のイメージをもらいます。 In message "[VBAで楽しく No.002] - AccessからExcel出力", > >現在、Access2002にてデータを管理する物を作って、 > >仕事で使用しているのですが、 > >これまでは、抽出データをレポートに出力するだけでよかったのですが、E > >xcelの定型フォーマットへ出力することになりました。 > > > >Helpでは、「TransferSpreadsheet」 メソッドで出来る様な事は記載されて > >いるのですが、決まったフォーマットへデータの埋め込みは > >出来そうも有りません。 > >どのようにやったら、実現出来るのでしょうか？ > > > >例 > > > >ID・・・・・・セルB4 > >Name・・・・・セルC4 > >Address ・・・セルB6 > >TEL ・・・・・セルD7 > > > >こんな感じで、このデータはこのセルといった具合に > >出力セルを指定したいのです。 --- とか、やりたいことを聞きます。 まぁ、ここからの仕様の理解度、プログラムへの落し方が 意外と評価をわけたり、腕の見せ所なんだけど、 /* * ２．仕様の理解度？ まずは、固定処理 */ えっと、ＡｃｃｅｓｓからＥｘｃｅｌファイルを開いて、 データをセットすればいいんだろ？ Excelのファイルは、 D:\vba002\TYPE.xls を開いて、 フォーム上の値を ID・・・・・・セルB4 Name・・・・・セルC4 Address ・・・セルB6 TEL ・・・・・セルD7 にセットすればいいや と理解した場合は、 Private Sub コマンド0_Click() On Error GoTo Err_コマンド0_Click Dim oApp As Object Set oApp = CreateObject("Excel.Application") oApp.Visible = True 'Only XL 97 supports UserControl Property On Error Resume Next oApp.UserControl = True '*1↓頭にCreateObjectで作成した変数を追加しただけ oApp.Workbooks.Open FileName:="D:\vba002\TYPE.xls" '^^^^ '*2 Range("A1").Value ="XXXX" でデータをセットする oApp.Range("B4").Value = Me![ID] oApp.Range("C4").Value = Me![Name] oApp.Range("B6").Value = Me![Address] oApp.Range("D7").Value = Me![TEL] Exit_コマンド0_Click: Exit Sub Err_コマンド0_Click: MsgBox Err.Description Resume Exit_コマンド0_Click End Sub とこんな感じかなぁ。 /vba/backno/vba002.html に画像付きで詳細あるけど、 最低限の、Excelを開いて、データをセットすることは出来たのかなぁ。 /* * ３．エラーチェックを追加、修正ヶ所を少なくする。 */ まぁ、次のレベルに進むと（自然に慣れて来るんだけど） エラー処理やプログラムの修正ヶ所を少なくする、 なんて工夫を身につけると思います。 /vba/backno/vba003.html に詳細あるけど、 In message "[VBAで楽しく No.003] - Dir関数でファイルの存在をチェックする", mag2 ID 0000099159さん wrote... >Dir("ファイル名") >で見つからなかった時に長さ０の文字列を返してくるので、 >If Dir("D:\vba002\TYPE.xls") = "" Then >でチェックできます。 > >Private Sub コマンド0_Click() >On Error GoTo Err_コマンド0_Click > > Dim oApp As Object > > '*3ファイルの存在をチェックする > If Dir("D:\vba002\TYPE.xls") = "" Then > MsgBox "D:\vba002\TYPE.xls を 確認して下さい" > Exit Sub '途中で抜ける > End If > > Set oApp = CreateObject("Excel.Application") > oApp.Visible = True > 'Only XL 97 supports UserControl Property > oApp.UserControl = True > > '*1↓頭にCreateObjectで作成した変数を追加しただけ > oApp.Workbooks.Open FileName:="D:\vba002\TYPE.xls" > '^^^^ > > '*2 Range("A1").Value ="XXXX" でデータをセットする > oApp.Range("B4").Value = Me![ID] > oApp.Range("C4").Value = Me![Name] > oApp.Range("B6").Value = Me![Address] > oApp.Range("D7").Value = Me![TEL] > >Exit_コマンド0_Click: > Exit Sub > >Err_コマンド0_Click: > MsgBox Err.Description > Resume Exit_コマンド0_Click > >End Sub > >*3 >みたいな感じでファイルの存在をチェックできます。 > >へぇ〜、よかったね。 >でも、 >D:\vba002\TYPE.xls >固定なんでしょ？ >Ｄドライブの無いマシーンにインストールする時は、 >プログラム直さないと動作しないジャン？ > >oApp.Workbooks.Open FileName:="D:\vba002\TYPE.xls" >を >oApp.Workbooks.Open FileName:="C:\vba002\TYPE.xls" >とかにね。 --- Ｄｉｒ関数を使って、 Excelの元ファイルが存在するかの エラーのチェックは出来たよね。 ここで問題だったのが、 固定で、 D:\vba002\TYPE.xls となってましたよね。 小細工で一ヶ所修正すればＯＫにするために、 Constで変数宣言を行いました。 http://www.ken3.org/backno/backno_vba02.html#5-4 に詳細あるけど、 In message "[VBAで楽しく No.005] - 変数・乱数・定数", >フォルダーの変更をした時には、全てのヶ所を修正しないといけません。 >そこで、 >Constを使用した定数宣言を行います。 > >Private Sub コマンド0_Click() >On Error GoTo Err_コマンド0_Click > > Const strXLSFILE As String = "D:\vba002\TYPE.xls" > '*4^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ > > Dim oApp As Object > > 'ファイルの存在をチェックする > If Dir(strXLSFILE) = "" Then > MsgBox strXLSFILE & " を 確認して下さい" > Exit Sub '途中で抜ける > End If > > Set oApp = CreateObject("Excel.Application") > oApp.Visible = True > 'Only XL 97 supports UserControl Property > oApp.UserControl = True > > '*1↓頭にCreateObjectで作成した変数を追加しただけ > oApp.Workbooks.Open FileName:=strXLSFILE > '^^^^ > > '*2 Range("A1").Value ="XXXX" でデータをセットする > oApp.Range("B4").Value = Me![ID] > oApp.Range("C4").Value = Me![Name] > oApp.Range("B6").Value = Me![Address] > oApp.Range("D7").Value = Me![TEL] > >Exit_コマンド0_Click: > Exit Sub > >Err_コマンド0_Click: > MsgBox Err.Description > Resume Exit_コマンド0_Click > >End Sub > >使用方法は、 >Const 変数名 as Type = 値 >と書きます。 >Const strXLSFILE As String = "D:\vba002\TYPE.xls" > >If Dir(strXLSFILE) = "" Then >と使用しているので、環境が変化した時は、 >頭の >Const strXLSFILE As String = "D:\vba002\TYPE.xls" >を >Const strXLSFILE As String = "F:\DATA\make\TYPE.xls" >など書き直せば動作するので、 >メンテナンスがラクです。 と Constを使用すると、プログラムの修正が楽なんですよ なんて、強引にＣｏｎｓｔの説明に使用してましたね。 長いよ説明が・・・で何がいいたいの？ えっと、 エラーチェックは入れましょうね と プログラムを修正しやすくするには かなぁ。 さらに一歩進めて、 プログラムを直さなくても動作する そんなことは出来ないの？ /* * ４．ＭＤＢと同フォルダのExcelファイルを開く */ さて、長かった前置きもこれくらいにして、 ＭＤＢと同フォルダのExcelファイルを開く をやってみましょう。 プログラムの仕様、やりたいことを少し変更します。 動作仕様 Accessのフォームからデータセットのボタンが押されたら、 ＭＤＢと同一のフォルダー\TYPE.xls (Excelのフォーマットファイル) を開いて、 フォーム上の値を ID・・・・・・セルB4 Name・・・・・セルC4 Address ・・・セルB6 TEL ・・・・・セルD7 にセットする。 同一のフォルダー\TYPE.xls が 存在しない場合は、 「インストールを確認して下さい」 とメッセージを表示し、何もしないで終了する。 なんか長くなったよね、 えっと、ＡｃｃｅｓｓのＭＤＢ起動位置を知るには、 http://www.ken3.org/backno/backno_vba02.html#6-2 で、 CurrentDb.Name なんて説明してたっけ、 ここに、D:\xxxx\yyyy\zzz.mdbが入っているから、 ここからフォルダーを抜き出して、 と 処理を追加すると下記のようになります。 Ａさん、Ｂさんのマシーンでインストール位置が違っても、 同じフォルダーにＭＤＢとＸＬＳを置いておけば 動作します。 少しは、カッコいいプログラムになったかなぁ。 えっ、まだまだだって？ いろいろとアナがあるけど、また今度かなぁ。 ＊気が付いてるバグ、Ｄ：のルートだとバグるよ（笑） 実行できるサンプル http://www.ken3.org/vba/lzh/vba007.lzh を落して、遊んでみてください。 Private Sub コマンド0_Click() On Error GoTo Err_コマンド0_Click Dim strXLSFILE As String 'Excelのファイル名格納場所 Dim oApp As Object 'Excelを操作するオブジェクト変数 Dim strMDBPATH As String Dim strWORK As String Dim i As Integer 'カウンター変数 'Accessの起動位置を取得 CurrentDb.NameにD:\xxxx\yyyy\zzz.mdbが入っている strWORK = CurrentDb.Name '後ろから１文字単位で￥を探す For i = Len(strWORK) To 1 Step -1 If Mid(strWORK, i, 1) = "\" Then Exit For '￥だったら抜ける Next i 'D:\xxxx\yyyy\zzz.mdb --> D:\xxxx\yyyy\ にする strMDBPATH = Mid(strWORK, 1, i) 'Excelの元ファイルの名前を作成 D:\xxxx\yyyy\ ＋ TYPE.xls strXLSFILE = strMDBPATH & "TYPE.xls" 'ファイルの存在をチェックする If Dir(strXLSFILE) = "" Then MsgBox strXLSFILE & " を 確認して下さい" Exit Sub '途中で抜ける End If Set oApp = CreateObject("Excel.Application") oApp.Visible = True 'Only XL 97 supports UserControl Property oApp.UserControl = True '*1↓頭にCreateObjectで作成した変数を追加しただけ oApp.Workbooks.Open FileName:=strXLSFILE '^^^^ '*2 Range("A1").Value ="XXXX" でデータをセットする oApp.Range("B4").Value = Me![ID] oApp.Range("C4").Value = Me![Name] oApp.Range("B6").Value = Me![Address] oApp.Range("D7").Value = Me![TEL] Exit_コマンド0_Click: Exit Sub Err_コマンド0_Click: MsgBox Err.Description Resume Exit_コマンド0_Click End Sub /* * ５．終わりの挨拶 */ 今回は、 過去のメルマガの復習？ と 環境の変化に強いプログラムって？ を少し書いてみました。 感想・質問などあったら、掲示板に書いてもらえるとうれしいです 三流プログラマーのＫｅｎ３でした。
ここまで、読んでいただきどうもです。ここから下は、三流君のホームページの紹介・案内です
目的の情報が見つかったか？少々心配しつつ、、、
|
気になったジャンル↓を選択してください。 人気記事(来場者が多いTOP3): Excel関係: Access関係: その他：VBAの共通関数やテキストファイルの操作など 開発時の操作: [F1を押してHELPを見る]/ [Debug.Print と イミディエイトウインドウ]/ [実行時エラーでデバッグ]/ [ウォッチ式とSTOP]/ [参照設定を行う] 仕様書(設計書？) XXXX書類: [基本設計書や要求仕様書]/ [テスト仕様書 テストデータ]/ [バグ票]/ [関数仕様書]/ [流れは 入力・処理・出力] ※↑文章の味付けが変わっていて、お口に合うかわかりませんが。。。 |
Blogとリンク:[三流君の作業日記]/
[VBAやASPのサンプルコード]/
広告-[通販人気商品の足跡]