Excel VBA質問箱 IV

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

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


7360 / 76732 ←次へ | 前へ→

【74960】Re:VBA解読お願いします
回答  ウッシ  - 13/11/1(金) 10:25 -

引用なし
パスワード
   こんにちは

エラーになった状態で、イミディエイトウィンドウに
?iWs.Range("F8")
と入力してEnterし内容を確認して下さい。
iWs.Range("E8")、Ws.Range(Trim(iWs.Range("E8")))も同様に。

開いたDBのテーブルにiWs.Range("F8")の内容と同名のフィールドが有る
のかどうかとか、確認するのはしんさん側でしか出来ませんから。


▼しん さん:
>以下VBAの解読をお願いします
>VBAで作られた集計データなのですが、どういうマクロが組まれているのか、又この集計表というデータに見積書データを取り込もうとするとE8とかかれた一番したのマクロが黄色くマーカーされ実行エラー{3136}と
>でてきてしまいます。詳しい方いらっしゃいましたら教えて下さい。(当方まだ勉強中で知識が浅いため)
>
>Option Explicit
>
>Dim iWb As Workbook
>Dim iWs As Worksheet
>
>Dim Db As Database
>Dim Rs As Recordset
>
>Dim wFileName As String
>
>Dim Wb As Workbook
>Dim Ws As Worksheet
>
>Private Sub Cmd_Run1_Click()
>
>If MsgBox("実行してもよろしいですか?", vbQuestion + vbYesNo, "メッセージ") = vbYes Then
>Syuukei
>End If
>
>End Sub
>
>Private Sub Cmd_Run2_Click()
>UserForm1.Show 1
>End Sub
>
>Private Sub Cmd_Run3_Click()
>UserForm2.Show 1
>End Sub
>
>Sub Syuukei()
>
>Set iWb = ThisWorkbook
>Set iWs = iWb.Worksheets("設定")
>
>wFileName = Dir(Trim(Sheets("設定").Range("D3")) & "\*.xls", vbNormal)
>
>If wFileName = "" Then
>Set iWs = Nothing
>Set iWb = Nothing
>MsgBox "集計するファイルが見つかりません..", vbCritical, "エラー"
>Exit Sub
>End If
>
>Set Db = OpenDatabase(Trim(iWs.Range("D4")))
>Set Rs = Db.OpenRecordset(Trim(iWs.Range("D5")), dbOpenTable)
>Rs.Index = "PrimaryKey"
>
>Do
>Set Wb = Workbooks.Open(Trim(iWs.Range("D3")) & "\" & wFileName)
>
>Set Ws = Wb.Worksheets(Trim(iWs.Range("D7")))
>Rs.Seek "=", Ws.Range(Trim(iWs.Range("E7")))
>If Rs.NoMatch Then
>Rs.AddNew
>Rs.Fields(Trim(iWs.Range("F7"))) = Ws.Range(Trim(iWs.Range("E7")))
>Else
>Rs.Edit
>End If
>Set Ws = Wb.Worksheets(Trim(iWs.Range("D8")))
>Rs.Fields(Trim(iWs.Range("F8"))) = Ws.Range(Trim(iWs.Range("E8")))
>・・・・・・・・
>
>補足

317 hits

【74959】VBA解読お願いします しん 13/11/1(金) 7:52 質問
【74960】Re:VBA解読お願いします ウッシ 13/11/1(金) 10:25 回答

7360 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free