Excel VBA質問箱 IV

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

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


1352 / 13644 ツリー ←次へ | 前へ→

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

【74959】VBA解読お願いします
質問  しん  - 13/11/1(金) 7:52 -

引用なし
パスワード
   以下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")))
・・・・・・・・

補足

【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")))
>・・・・・・・・
>
>補足

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