[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ExecuteExcel4Macroの使用方法』（わかあゆ）
ExecuteExcel4Macro関数を使って、開いていないファイルから転記するマクロを考えています。 関係ファイルは、同じドライブの同じフォルダ内にあります。 たとえば、JドライブのTestフォルダにある状況下で下記のマクロを作成、実行したところ、正常に 動作しました。
Sub Sample2()
Dim i As Long
Dim i2 As Long
For i = 1 To 3
For i2 = 1 To 20
Cells(i2, i) = ExecuteExcel4Macro("'J:\Test\[Book1.xls]Sheet1'!R" & i2 & "C" & i)
Next i2
Next i
End Sub
そこで、収納先ドライブが変化しても対応するようにしようと、ThisWorkbook.Pathを使って、 次のようにコードを変更してみたところ、当該セルのすべてに#REF!が表示されてしまいました。
Sub Sample4()
Dim i As Long
Dim i2 As Long
Dim TWP As Variant
TWP = ThisWorkbook.Path
For i = 1 To 3
For i2 = 1 To 20
Cells(i2, i) = ExecuteExcel4Macro("'" & TWP & ":\[Book1.xls]Sheet1'!R" & i2 & "C" & i)
Next i2
Next i
End Sub
どこを直せば正常に動作するのか、どなたかお教えいただけませんか？
また、参照元ファイル（Book1.xls）のシート名がSheet1ではなく、「基本」のとき、 \[Book1.xls]Sheet1'!の部分の記述はどのようにすればよいのかについても、お教えいただければ 幸いです。 [Excel2003,WindowsXP]
変数TWPに ThisWorkbook.Path を代入した後に メッセージボックスなどで、何が入っているか 確認出来る様にしてみられてはどうでしょう。
また ＞"'" & TWP & ":\[Book1.xls]Sheet1'!R" の部分で、目的の "'J:\Test\[Book1.xls]Sheet1'!R" と言う文字列が出来ているのかも 確認されると良いと思います。
メッセージボックスが良く分からなければ
どこかのセルに書き出してみても良いかもしれません。
Range("A1").Value = "'" & TWP & ":\[Book1.xls]Sheet1'!R"
それから、数式で =パス\[ブック名]シート名!セル番地 と指定すると 閉じているブックでも値を参照する事が出来るので ExecuteExcel4Macroを使わなくても出来るのではないかと思います。 数式を埋め込んだ後、値化の必要が有るかもしれませんが。
例えば ='J:\Test\[Book1.xls]Sheet1'!A1 の式を入れると、セルの値が参照出来ますね？ Sheet1のシート名が「基本」だったら 特に疑問も無く ='J:\Test\[Book1.xls]基本'!A1 の様に変更される事と思います。
ExecuteExcel4Macroを使う場合も同様の変更で良いと思います。
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－ －－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
過去ログを探そうかと思ったのですが
数式で参照するサンプルコードを載せておきます。スミマセン。
'------
Sub 例えば()
Dim TWP As Variant, PBS As Variant
TWP = ThisWorkbook.Path
MsgBox "TWPの値は " & TWP & " です。"
PBS = "'" & TWP & "\[Book1.xls]Sheet1'"
MsgBox "参照するのは " & PBS & " のシートです。"
Range("A1:C10").Formula = "=IF(" & PBS & "!A1="""",""""," & PBS & "!A1)"
Range("A1:C10").Value = Range("A1:C10").Value
End Sub
'------
ExecuteExcel4Macroを使う物は過去ログも探しやすいと思うので 探してみられても良いと思います。 思いがけない良い情報が得られるかもしれません。 http://www.excel.studio-kazu.jp/cgi-bin/estindex/estseek2.cgi?phrase=ExecuteExcel4Macro%E3%80%80%E9%96%89%E3%81%98%E3%81%9F%EF%BD%9C%E9%96%8B%E3%81%84%E3%81%A6%EF%BD%9C%E9%96%8B%E3%81%8B%E3%81%9A&perpage=10&attr=@uri+STRINC+kazuwiki&order=@uri+STRD&clip=-1&navi=0
(HANA)
HANAさんと書いている内容がかぶっちゃったので、修正部分は割愛。 ＞どこを直せば正常に動作するのか、どなたかお教えいただけませんか？ ちょっと厳しい書き方になりますが、根本的な部分では、 「デバッグをしなさい」「デバッグのやり方を覚えなさい」です。 15年ほど前の私なら、いきなり ExecuteExcel4Macro を走らせずに、 msgbox "'" & TWP & ":\[Book1.xls]Sheet1'!R" & i2 & "C" & i てな具合で出力テストをするケースです。 VBAが思ったとおりに動かなくて挫折する人はたくさんいると思いますが、 「プログラムは思ったとおりに動くのではなく、書いたとおりにしか動く」です。 思っている内容と書いた内容が同じかどうか、確認するテクニックを身につけておく ことをお勧めします。 debug.print、ウォッチ式、ローカルウィンドウなど便利なデバッグ機能がいっぱいあるので、 使いこなせるようにしましょう。 あと、4.0マクロは使い続けることができるかどうかわからない技術です。 便利な部分はあるのですが、Excel5.0までのブックと互換性を保つための どちらかといえば化石のような機能なので、将来のバージョンで切り捨てら れる覚悟もしておいてください。 (みやほりん)(-_∂)b
おおっと、HANAさんから、「表現が迷走しちょるぜよ」と連絡がありました。 （誤）「プログラムは思ったとおりに動くのではなく、書いたとおりにしか動く」 （正）「プログラムは思ったとおりに動くのではなく、書いたとおりに動く」 HANAさん、ご指摘ありがとうございます。 (みやほりん)(-_∂)b
あらら、こそっと直して頂こうと思って耳打ちしましたのに。 しかも！！お国言葉丸出しでしたか。（笑）失礼しました。 気を付けてるんですけどねぇ。。。なかなか難しいです。
って、無駄話だけでもあれ（どれ？）なんで 以下、わかあゆさんへ。。。
この辺りとかご覧になってみられても良いのではないかと思います。 http://www.asahi-net.or.jp/~ef2o-inue/vba_k/sub04_040_025.html ☆Excelでお仕事！☆ VBA基本(イディミエイト・ウォッチ・ローカルウィンドウ)
(HANA)
数式の利用で事足りると思いますが、ＡＤＯを使った別アプローチで
標準モジュールにＡＤＯ関連プロシジャー群
'==============================================================================
Private cn As Object
'==============================================================================
Function open_ado_excel(book_fullname As String) As Long
On Error Resume Next
link_opt = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & book_fullname & ";" & _
"Extended Properties='Excel 8.0; HDR=No'"
Set cn = CreateObject("ADODB.Connection")
cn.Open link_opt
open_ado_excel = Err.Number
On Error GoTo 0
End Function
'==============================================================================
Sub close_ado()
On Error Resume Next
cn.Close
On Error GoTo 0
End Sub
'==============================================================================
Function get_exec_sql(sql_str, rs As Object) As Long
On Error Resume Next
Set rs = cn.Execute(sql_str)
get_exec_sql = Err.Number
If Err.Number <> 0 Then
MsgBox Err.Number & "::" & Err.Description
End If
On Error GoTo 0
End Function
別の標準モジュールに
'===========================================================================
Sub test()
Dim rs As Object
Dim sql As String
If open_ado_excel(ThisWorkbook.Path & "\Book1.xls") = 0 Then
sql = "SELECT * FROM [Sheet1$A1:c20]"
If get_exec_sql(sql, rs) = 0 Then
Range("a1").CopyFromRecordset rs
On Error Resume Next
rs.Close
On erro GoTo 0
Call close_ado
Set rs = Nothing
End If
End If
End Sub
これだと書き込み出来ます。要･不要は、ともかくとして・・・。
Excel2002で確認しました。
ichinose
もうひとつ別案。 転記するデータにもよりますが、もし、1行目が項目見出しとなっているような リスト形式のデータセットであれば、データベースクエリで ブックを開かず、また、マクロも使わず、特定の表範囲を参照することができます。 (みやほりん)(-_∂)b
とりあえず
>Cells(i2, i) = ExecuteExcel4Macro("'" & TWP & ":\[Book1.xls]Sheet1'!R" & i2 & "C" & i)
の、「：」が余計なのだと思いますが 私なら「開かずに」ではなくてApplication.ScreenUpdatingで「開いているがそれを見せずに」 処理します。 その方が早い場合も多く、処理が簡単だからです。
（ｍｏｍｏ）
勉強し始めの人が、なぜ開きたくないというのか、なんとなく解るけど。 その内に、こだわる必要もなくなるのから、結構無意味。 おまけ。 BJ
Sub Sample4()
Dim i As Long
Dim i2 As Long
Dim TWP As Variant, st As String
TWP = ThisWorkbook.Path
For i = 1 To 3
For i2 = 1 To 20
st = "'" & TWP & "\[Book1.xls]Sheet1'!R" & i2 & "C" & i
If Application.ExecuteExcel4Macro("ISBLANK(" & st & ")") = False Then
Cells(i2, i) = Application.ExecuteExcel4Macro(st)
End If
Next i2
Next i
End Sub
HANAさん、みやほりんさん、ichinoseさん、ｍｏｍｏさん、初心者の私にお付き合いいただき ありがとうございます。 ｍｏｍｏさん, >「：」が余計なのだと思いますが 「：」を削除したら、すーと動作しました。感激です！ HANAさんの助言にそってセルに表示し確認したところ、間違いなく（私がコードで指示したと おり）文字列が成立していました。にもかかわらず、動作させるとエラー、デバッグでも黄色 表示・・・壁にぶつかっていました。
みやほりんさんの次の言葉、大切にしたいと思います。 >VBAが思ったとおりに動かなくて挫折する人はたくさんいると思いますが、 >「プログラムは思ったとおりに動くのではなく、書いたとおりにしか動く」です。 >思っている内容と書いた内容が同じかどうか、確認するテクニックを身につけておく >ことをお勧めします。 >debug.print、ウォッチ式、ローカルウィンドウなど便利なデバッグ機能がいっぱいあるので、 >使いこなせるようにしましょう。 HANAさんが紹介くださったところにアクセスして勉強します。 なお、次の言葉、大変気になり、能力のない私は戸惑っております。 >あと、4.0マクロは使い続けることができるかどうかわからない技術です。 >便利な部分はあるのですが、Excel5.0までのブックと互換性を保つための >どちらかといえば化石のような機能なので、将来のバージョンで切り捨てら >れる覚悟もしておいてください。
では、他の方法を採用すればよいと言うことなのでしょうが、このあとの作業で私自身が手を 入れることができるものでないと・・・と考えてしまうのです。 参照先があるセルの値によって変化することに対応させる必要があるのです。転記するセル範 囲は一定なのですが・・・
このコメントを載せようとしたところ、衝突してしまいました。 返事が遅れたこと、お詫びいたします。
BJさん、ありがとうございます。 早速、試してみると共に、コードを読み解いて見ます。 (わかあゆ)
4.0マクロ自体は過去の遺物です。マニュアルを探しても手に入ら ない代物です。
>このあとの作業で私自身が手を >入れることができるものでないと・・・と考えてしまうのです。 難しい技術は使っていないと思われます。 開いて、処理して閉じてでも私はかまわないと思います。 どうせマクロで自動処理するのだから、ブックを開くと何が不都合 なのだろう、と逆に疑問に思ってしまうわけです。だから、問題は、 「なぜ開きたくないの？」というところです。ここがわからないと、 アドバイスはしにくいのです。 単に、画面の見栄えの問題、ということなら、 非表示ブックとしたり、、ｍｏｍｏさんも書かれているように、 画面をストップして見せかけだけ、ブックが開かれていないように もできます。 運用全体が不明ですが、 ＞ 参照先があるセルの値によって変化することに対応させる必要があるのです。転記するセル範 ＞ 囲は一定なのですが・・・ ちょっと言葉だけではわかりにくいですよね。セルの値で参照するブックを切り替える、というこ とですか？私なら、オーソドックスにそのブックを開いて貼付するか、 参照式（クエリその他）を固定にして、マクロでブック名の方を変更するかな？ (みやほりん)(-_∂)b
みやほりんさん、本当にありがとうございます。 >「なぜ開きたくないの？」 仲間で使っていくので、開いていない状況でマクロを動作させてうまくいかないと言われたり、 正常に動作しているもの（使用者が指定した学年の情報が転記されているもの）として作業を 進めることがないように、開いていなくても正常に処理させたいと考えたのです。 でも、途中から「こうでなくてはならない」という考えにかたまってしまっていたかも知れま せん。 >運用全体が不明 ファイル、シートの状況は下記のようなものです。
参照元：「年間基本」ファイルの「設定」シート
A B C D E F G H I J K L M N O P Q R S T ～
5 ○
6
7
8
9
～
374
375
376
377
378
379 行
転記先：「学年基本」ファイルの「設定」シート
A B C D E F G H I J K L M N O
3 6 年
4 1 組
5
6
7
8
9
～
374
375
376
377
378
379
$A$3に記入された学年を表す数に応じて、
6のときは、参照元の$A$5:$E$379を転記先の$A$5:$E$379に
5のときは、参照元の$F$5:$K$379を転記先の$A$5:$E$379に
4のときは、参照元の$L$5:$Q$379を転記先の$A$5:$E$379に
3のときは、参照元の$R$5:$W$379を転記先の$A$5:$E$379に
2のときは、参照元の$X$5:$AC$379を転記先の$A$5:$E$379に
1のときは、参照元の$AD$5:$AJ$379を転記先の$A$5:$E$379に
転記処理を進めたいのです。
マクロで参照元：「年間基本」ファイルが開いていないときは開き、転記処理を進め、 開いた参照元：「年間基本」ファイルを閉じるということができれば、ExecuteExcel4Macro を使う必要はないわけですね・・・（浅はかな考えでしょうか？） (わかあゆ)
私なら前述のとおり開いて処理しますので（もちろん開いていても大丈夫ですが） 下のようなコードで処理します。
Sub test()
Const OpenPath As String = "D:\"
Const OpenName As String = "年間基本.xls"
Dim wb As Workbook
Dim OpenFlg As Boolean
Dim myAdd As String
Application.ScreenUpdating = False
For Each wb In Workbooks
If wb.Name = OpenName Then
OpenFlg = True
Exit For
End If
Next wb
If OpenFlg = True Then
Set wb = Workbooks(OpenName)
Else
Set wb = Workbooks.Open(OpenPath & OpenName)
End If
With ThisWorkbook.Worksheets("設定")
myAdd = Choose(.Range("A3").Value, "BD5:BM379", "AT5:BC379", "AJ5:AS379", "Z5:AI379", "P5:Y379", "A5:O379")
.Range("A5:O379").Value = wb.Worksheets("設定").Range(myAdd).Value
End With
If OpenFlg = False Then
wb.Close False
End If
Application.ScreenUpdating = True
End Sub
サンプルとして、わかあゆさんが掲示されたとおりの条件で作成していますが ６年生のときの範囲だけ大きいのは間違いでしょうか？ ファイル名やシート名、年間基本ブックのパスなどをご自身の環境に修正して ６年生のときの参照範囲を確かめてから試してみてください。
ブックを開くとか開かないとかを気にしなくても良い事は解っていただけるかと思いますが （ｍｏｍｏ）
ｍｏｍｏさん、本当にありがとうございます。 >６年生のときの範囲だけ大きいのは間違いでしょうか？ あれ！大間違いです。正式にはつぎのとおりでした。 6のときは、参照元の$A$5:$E$379を転記先の$A$5:$E$379に 5のときは、参照元の$F$5:$J$379を転記先の$A$5:$E$379に 4のときは、参照元の$K$5:$O$379を転記先の$A$5:$E$379に 3のときは、参照元の$P$5:$T$379を転記先の$A$5:$E$379に 2のときは、参照元の$U$5:$Y$379を転記先の$A$5:$E$379に 1のときは、参照元の$Z$5:$AD$379を転記先の$A$5:$E$379に 自分で修正して確かめたいと思います。 分からないことが出ましたら、また質問いたします。 そのときは、よろしくお願いいたします。 (わかあゆ)
やっぱりそうでしたか、
修正箇所は下の２行ですね。（余計なお節介）
> myAdd = Choose(.Range("A3").Value, "BD5:BM379", "AT5:BC379", "AJ5:AS379", "Z5:AI379", "P5:Y379", "A5:O379")
> .Range("A5:O379").Value = wb.Worksheets("設定").Range(myAdd).Value
myAdd = Choose(.Range("A3").Value, "Z5:AD379", "U5:Y379", "P5:T379", "K5:O379", "F5:J379", "A5:E379")
.Range("A5:E379").Value = wb.Worksheets("設定").Range(myAdd).Value
（ｍｏｍｏ）
ｍｏｍｏさん、最後の最後までありがとうございます。
厚かましいと叱られそうですが、関係ファイルが「管理」というフォルダに入っています。
今作成中のものは、このフォルダごと、Sドライブに入れておりますが、最終的に他の
場所に移すことになります。
最終の保管場所が特定できませんので、
>Const OpenPath As String = "D:\"
のDドライブをフォルダのあるパスを取得して処理することは可能でしょうか。
その場合、質問の最初に提示しましたように変数を使って
Dim TWP As Variant
TWP = ThisWorkbook.Path
とし、
Const OpenPath As String = TWP
して、よろしいのでしょうか。
(わかあゆ)
>その場合、質問の最初に提示しましたように変数を使って > Dim TWP As Variant > TWP = ThisWorkbook.Path >とし、 > Const OpenPath As String = TWP >して、よろしいのでしょうか。
学年基本ブックと同じパスでよければ Dim OpenPath As String OpenPath = ThisWorkbook.Path & "\" としてください。
Constでの宣言は固定値なので変動するオブジェクトのプロパティ値や変数は設定できません。 （ｍｏｍｏ）
ｍｏｍｏさん、感謝、感謝です。 >Constでの宣言は固定値なので変動するオブジェクトのプロパティ値や変数は設定できません。 このようなことも、私だけではなかなかたどり着けません。「あれ、だめだ」「これでは、だめだ」 迷路に迷い込んでいたでしょう。 ありがとうございました。 (わかあゆ)
Sub test()
MsgBox checkwd
End Sub
Function checkwd()
Dim objWd As Window
Dim blChk As Boolean
For Each objWd In Application.Windows
If objWd.Caption = "年間基本.xls" Then
blChk = True
End If
Next objWd
checkwd = blChk
End Function
年間基本ファイルが開いているかどうかを確認するテストコードです。
Sub test()
Function checkwd() という二つのプロシージャで構成されています。
開いているウィンドウの中に「年間基本」という文字列のCaption
（ウィンドウタイトル）があるかどうかをチェックしています。
test を実行しますと、あればtrue なければFalseのメッセージが表示
されます。このTrue、FalseはIfステートメントの条件式部分で使用する
ことができます。Sub test()を書き換えてみます。
Sub test()
if checkwd then
msgbox "年間基本ファイルは開かれています"
Else
msgbox "年間基本ファイルが開いていません"
End If
End Sub
開かれているときは次の転記処理に移り、開かれていない場合には
開く処理を行います。この場合、開く処理を行えばよいので、
Sub test()
If checkwd Then
MsgBox "年間基本ファイルは開かれています"
Else
Workbooks.Open Filename:=Thisworkbook.path & "\年間基本.xls"
End If
End Sub
これで「年間ブックを必ず開いた状態にする」という部分まではできました。
次が私なりの完成形かな？プロシージャが三つになりますけど。
Sub test()
If checkwd Then
MsgBox "年間基本ファイルは開かれています"
Else
Workbooks.Open Filename:=ThisWorkbook.Path & "\年間基本.xls"
End If
Call tenki(Workbooks("年間基本.xls"))
objWb.Close savechanges:=False
End Sub
Function checkwd()
Dim objWd As Window
Dim blChk As Boolean
For Each objWd In Application.Windows
If objWd.Caption = "年間基本.xls" Then
blChk = True
End If
Next objWd
checkwd = blChk
End Function
Function tenki(ByVal Wb As Workbook)
Dim lngOfst As Long, lngRsz As Long, lngGrd As Long
Dim rng1 As Range, rng2 As Range
With ThisWorkbook
lngGrd = .Worksheets("設定").Range("A3").Value
Select Case lngGrd
Case Is = 6
lngOfst = 0
lngRsz = 5
Case Is = 2, 3, 4, 5
lngOfst = (6 - lngGrd) * 6 - 1
lngRsz = 6
Case Is = 1
lngOfst = (6 - lngGrd) * 6 - 1
lngRsz = 7
Case Else
lngRsz = 0
End Select
If lngRsz > 0 Then
Set rng1 = .Worksheets("設定").Range("A5:E379")
Set rng2 = Wb.Worksheets("設定").Range("A5:E379").Offset(0, lngOfst)
rng1.Resize(, lngRsz).Value = rng2.Resize(, lngRsz).Value
Else
MsgBox "学年が未記入です"
End If
End With
End Function
あぎゃずいぶん話が進んでいるし、範囲なんか修正前の状態だし。
ま、参考程度に。
(みやほりん)(-_∂)b
いつもながら丁寧な解説＋コードですね。 先に横からお邪魔してしまってすみません。 同じ処理に対して違う方のコードを拝見させて頂くのが一番勉強になります。 私からお詫びとお礼を^^ （ｍｏｍｏ）
みやほりんさん、重ね重ねありがとうございます。 お示しいただきましたものを参考に、マクロ理解を深めたいと思います。 (わかあゆ)
解決後ですが、参考程度に・・・・。 まず、Excel4Macroの資料ですが、英語版なら
まっ、みやほりんさんの過去の遺物というくだりは同感ですけど、ＶＢＡにもバグがあって、 これ使うと助かる場合もあったので 載せておきます。
それとＡＤＯのコードを掲載したので、ちょっと ｍｏｍｏさんのコードも参考にさせてもらって
標準モジュールに
'=====================================================================
Sub read_data()
Const OpenName As String = "年間基本.xls"
Dim wb As Workbook
Dim rs As Object
Dim sql As String
Dim myAdd As String
Dim OpenFlg As Long
On Error Resume Next
Set wb = Workbooks(OpenName)
OpenFlg = Err.Number
On Error GoTo 0
If OpenFlg = 0 Then wb.Close False
If open_ado_excel(ThisWorkbook.Path & "\" & OpenName) = 0 Then
With ThisWorkbook.Worksheets("sheet1")
myAdd = Choose(.Range("A3").Value, "Z5:AD379", "U5:Y379", "P5:T379", "K5:O379", "F5:J379", "A5:E379")
sql = "SELECT * FROM [設定$" & myAdd & "]"
If get_exec_sql(sql, rs) = 0 Then
.Range("a5").CopyFromRecordset rs
Call rs_close(rs)
Call close_ado
Set rs = Nothing
End If
End With
End If
If OpenFlg = 0 Then Workbooks.Open ThisWorkbook.Path & "\" & OpenName
End Sub
別の標準モジュールに前回も投稿したＡＤＯ関連プロシジャー群
'==============================================================================
Private cn As Object
'==============================================================================
Function open_ado_excel(book_fullname As String) As Long
On Error Resume Next
link_opt = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & book_fullname & ";" & _
"Extended Properties='Excel 8.0; HDR=No'"
Set cn = CreateObject("ADODB.Connection")
cn.Open link_opt
open_ado_excel = Err.Number
On Error GoTo 0
End Function
'==============================================================================
Sub close_ado()
On Error Resume Next
cn.Close
set cn=Nothing
On Error GoTo 0
End Sub
'==============================================================================
Function get_exec_sql(sql_str, rs As Object) As Long
On Error Resume Next
Set rs = cn.Execute(sql_str)
get_exec_sql = Err.Number
If Err.Number <> 0 Then
MsgBox Err.Number & "::" & Err.Description
End If
On Error GoTo 0
End Function
尚、コードのあるブックと年間基本.xlsは、同じフォルダ上にあるものとします。
処理速度も興味があったら、調べてみてください。
もっとも今回の事例では、数式で読み込む方法や 実際にブックを読み込んで転記する方法で良いと思いますけどね！！
ichinose
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.