エクセルの学校


[[20100208214907]] 『ExecuteExcel4Macroの使用方法』(わかあゆ) >>BOT

[ 初めての方へ | 一覧(最新更新順) |

|
| 全文検索 | 過去ログ | HOME ]

 

『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)

 数式の利用で事足りると思いますが、ADOを使った別アプローチで

 標準モジュールにADO関連プロシジャー群
 '==============================================================================
 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で「開いているがそれを見せずに」
 処理します。
 その方が早い場合も多く、処理が簡単だからです。

 (momo)


 勉強し始めの人が、なぜ開きたくないというのか、なんとなく解るけど。
 その内に、こだわる必要もなくなるのから、結構無意味。
 おまけ。 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さん、momoさん、初心者の私にお付き合いいただき
 ありがとうございます。
 momoさん,
 >「:」が余計なのだと思いますが
 「:」を削除したら、すーと動作しました。感激です!
 HANAさんの助言にそってセルに表示し確認したところ、間違いなく(私がコードで指示したと
 おり)文字列が成立していました。にもかかわらず、動作させるとエラー、デバッグでも黄色
 表示・・・壁にぶつかっていました。

 みやほりんさんの次の言葉、大切にしたいと思います。
 >VBAが思ったとおりに動かなくて挫折する人はたくさんいると思いますが、
 >「プログラムは思ったとおりに動くのではなく、書いたとおりにしか動く」です。
 >思っている内容と書いた内容が同じかどうか、確認するテクニックを身につけておく
 >ことをお勧めします。 
 >debug.print、ウォッチ式、ローカルウィンドウなど便利なデバッグ機能がいっぱいあるので、
 >使いこなせるようにしましょう。
 HANAさんが紹介くださったところにアクセスして勉強します。
 なお、次の言葉、大変気になり、能力のない私は戸惑っております。
 >あと、4.0マクロは使い続けることができるかどうかわからない技術です。
 >便利な部分はあるのですが、Excel5.0までのブックと互換性を保つための
 >どちらかといえば化石のような機能なので、将来のバージョンで切り捨てら
 >れる覚悟もしておいてください。

 では、他の方法を採用すればよいと言うことなのでしょうが、このあとの作業で私自身が手を
 入れることができるものでないと・・・と考えてしまうのです。
 参照先があるセルの値によって変化することに対応させる必要があるのです。転記するセル範
 囲は一定なのですが・・・

 このコメントを載せようとしたところ、衝突してしまいました。
 返事が遅れたこと、お詫びいたします。

 BJさん、ありがとうございます。
 早速、試してみると共に、コードを読み解いて見ます。
 (わかあゆ)


 4.0マクロ自体は過去の遺物です。マニュアルを探しても手に入ら
ない代物です。

 >このあとの作業で私自身が手を
 >入れることができるものでないと・・・と考えてしまうのです。
難しい技術は使っていないと思われます。
開いて、処理して閉じてでも私はかまわないと思います。
どうせマクロで自動処理するのだから、ブックを開くと何が不都合
なのだろう、と逆に疑問に思ってしまうわけです。だから、問題は、
「なぜ開きたくないの?」というところです。ここがわからないと、
アドバイスはしにくいのです。
 
単に、画面の見栄えの問題、ということなら、
非表示ブックとしたり、、momoさんも書かれているように、
画面をストップして見せかけだけ、ブックが開かれていないように
もできます。
 
運用全体が不明ですが、
> 参照先があるセルの値によって変化することに対応させる必要があるのです。転記するセル範
> 囲は一定なのですが・・・
ちょっと言葉だけではわかりにくいですよね。セルの値で参照するブックを切り替える、というこ
とですか?私なら、オーソドックスにそのブックを開いて貼付するか、
参照式(クエリその他)を固定にして、マクロでブック名の方を変更するかな?
(みやほりん)(-_∂)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年生のときの範囲だけ大きいのは間違いでしょうか?
 ファイル名やシート名、年間基本ブックのパスなどをご自身の環境に修正して
 6年生のときの参照範囲を確かめてから試してみてください。

 ブックを開くとか開かないとかを気にしなくても良い事は解っていただけるかと思いますが
 (momo)

  momoさん、本当にありがとうございます。
 >6年生のときの範囲だけ大きいのは間違いでしょうか?
 あれ!大間違いです。正式にはつぎのとおりでした。
   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に
 自分で修正して確かめたいと思います。
 分からないことが出ましたら、また質問いたします。
 そのときは、よろしくお願いいたします。  (わかあゆ)


 やっぱりそうでしたか、
 修正箇所は下の2行ですね。(余計なお節介)
 >   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

 (momo)

 momoさん、最後の最後までありがとうございます。
 厚かましいと叱られそうですが、関係ファイルが「管理」というフォルダに入っています。
 今作成中のものは、このフォルダごと、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での宣言は固定値なので変動するオブジェクトのプロパティ値や変数は設定できません。
 (momo)

 momoさん、感謝、感謝です。
 >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


 いつもながら丁寧な解説+コードですね。
 先に横からお邪魔してしまってすみません。
 同じ処理に対して違う方のコードを拝見させて頂くのが一番勉強になります。
 私からお詫びとお礼を^^
 (momo)

 みやほりんさん、重ね重ねありがとうございます。
 お示しいただきましたものを参考に、マクロ理解を深めたいと思います。
 (わかあゆ)

 解決後ですが、参考程度に・・・・。
 まず、Excel4Macroの資料ですが、英語版なら

http://www.microsoft.com/downloads/details.aspx?FamilyID=c09bf7f7-d30e-4ce9-8930-5d03748ca5cd&DisplayLang=en

 まっ、みやほりんさんの過去の遺物というくだりは同感ですけど、VBAにもバグがあって、
 これ使うと助かる場合もあったので 載せておきます。

 それとADOのコードを掲載したので、ちょっと momoさんのコードも参考にさせてもらって

 標準モジュールに

 '=====================================================================
 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

 別の標準モジュールに前回も投稿したADO関連プロシジャー群

 '==============================================================================
 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.