VBA ユーザーフォームの内容を別ブックに反映

質問

「ユーザーフォーム.xlsm」のファイル名でVBAのユーザーフォームを作成しました。
このユーザーフォームで入力した内容値を別ブックである「ご意見箱.xlsx」のsheet1に反映させたいです。

「ユーザーフォーム.xlsm」と「ご意見箱.xlsx」は、「デスクトップ」上に置いております。

ユーザーフォーム上の「確定保存」というコマンドボタンをクリックしたタイミングで以下のようなイベントの構文で記述しました。

(1)バックグラウンドで「ご意見箱.xlsx」をファイルオープンさせて
(2)「ご意見箱.xlsx」の「sheet１」の最終行を取得して
(3)最終行の連番を振り
(4)オプションボタンの選択値とテキストボックスの内容を書き込み反映して
(5)自動で上書き保存して閉じる。
(6)もしオプションボタンの未選択かテキストボックスの未入力があった場合は、警告メッセージを表示させる

現状では(1)のバックグラウンドでのファイルオープンまでは問題なく動作しているのですが、(2)以降で躓いている状況です。

ユーザーフォームの構成と反映先となる「ご意見箱.xlsx」ファイルのsheet1の構成は、画像添付のとおりとなっております。

使用アプリケーション：Excel 2013です。

ここに辿り着くまでにさんざん書籍やWEBなどで調べに調べまくってトライ＆エラーを繰り返してきたのですが、もしお分かりになる方がいらっしゃいましたら、皆様にご教示賜りたく何卒宜しくお願い申し上げます。

回答No.2

ushi2015 · ベストアンサー

こんにちは
オプションボタンの選択値とは何ですか？
キャプションか番号か？
Private Sub 確定保存_Click()
　　Dim tBk As Workbook
　　Dim p As String
　　Dim tSh As Worksheet
　　Dim i As Long
　　Dim j As Long
　　Dim v As Boolean
　　If Me.TextBox1 = "" Then
　　　　MsgBox "テキスト 無し"
　　　　Exit Sub
　　Else
　　　　v = False
　　　　For i = 1 To 3 'オプションが連番になっているとして、最終番号まで
　　　　　　If Me.Controls("OptionButton" & i).Value = True Then
　　　　　　　　v = True
　　　　　　　　Exit For
　　　　　　End If
　　　　Next
　　　　If v = False Then
　　　　　　MsgBox "オプション選択無し"
　　　　　　Exit Sub
　　　　End If
　　End If
　　p = ThisWorkbook.Path & "\ご意見箱.xlsx"
　　If Dir(p) <> "" Then
　　　　Application.ScreenUpdating = False
　　　　Set tBk = Workbooks.Open(p)
　　Else
　　　　MsgBox "ご意見箱.xlsx 無し"
　　　　Exit Sub
　　End If
　　Set tSh = tBk.Worksheets("Sheet1")
　　With tSh
　　　　j = .Range("A" & Rows.Count).End(xlUp).Row
　　　　.Cells(j + 1, "A") = .Cells(j, "A") + 1
　　　　.Cells(j + 1, "C") = i 'Me.Controls("OptionButton" & i).Caption
　　　　.Cells(j + 1, "D") = Me.TextBox1.Text
　　End With
　　tBk.Save
　　tBk.Close
　　Application.ScreenUpdating = True
End Sub

お礼

こんにちは、お世話になります。
早速、具体的で親身なアドバイスを下さり真に有難うございます。
おかげさまで動作させたいことに対する全体像のロジックが少し理解できました。
また宜しくお願い致します。

補足

ushi2015様へ

こんにちは、お世話になります。
早速、具体的なアドバイスを下さり真に有難うございます。

ご質問にございました、オプションボタンの選択値は、キャプションになります。

その旨、お返事いたします。

また頂いた内容で試させていただきます。

回答No.1

quindecillion

ExcelVBAに詳しくないので恐縮ですが、バックグラウンドで開いても普通に開いても操作できるのは開いたブックである「ご意見箱.xlsx」のはずです。
開いた後にActiveで他のブックを選択していないかの確認が必要ではないでしょうか。

当方はExcel2013で、情報のみを管理しているシートを開いて、そこの表をコピーしてマクロ側に貼付け使用するという質問者様と逆のことをしていますが、その際に使っているつたないマクロを下記に載せておきます。

mybook = "ユーザーフォム.xlsm"
datbook = "ご意見箱.xlsx"
' Application.ScreenUpdating = False　一応Bookを開いたのが見えるようにしています。
On Error GoTo エラー処理
'ファイルオープン
hyoubook = Left(ThisWorkbook.Path, 5) & "\" & datbook　'こちらの用途のままです。
　　　'質問者様の環境に合わせて調整をお願い致します。
Workbooks.Open hyoubook　'この時点で操作できるのは開いた「ご意見箱.xlsx」です。
'操作できないのであればWindows(hyoubook).Activateなどで操作するのはhyoubookとしてあげればいいかと。
Range("date1[#All]").Copy　'この時点で「ご意見箱.xlsx」のデータベースの範囲がコピーされます。
　　　'この箇所の操作でa=Cells(Rows.Count, 1).End(xlUp).Rowとすると「ご意見箱.xlsx」の最終行が取得できています。
Windows(mybook).Activate　'ここで「ユーザーフォーム.xlsm」に操作を移します
Worksheets(5).Select
S = Selection.Address　'ここら下はこちらの環境依存です。
If S = "$A$1" Then
Worksheets(5).Select
Else
Worksheets(5).Range("A1").Select
End If
ActiveSheet.Paste　'コピーした部分を貼り付けています。
Application.DisplayAlerts = False '警告非表示　
　　　'開いたブックを保存しないでとじています。保存する場合は別処理になります。
Workbooks(datbook).Close
Application.DisplayAlerts = True '警告再表示
Worksheets(2).Activate
エラー処理:
MsgBox Err.Description

見当違いなどでお役に全く立てないかもしれませんが、ご参考になれば幸いです。

お礼

こんにちは、お世話になります。
いの一番に具体的で親身なアドバイスを下さり真に有難うございます。
頂戴したご回答アドバイスも一つの事例としての構文も参考にさせて頂きました。
如何せん私もVBA歴が浅いので、勉強になりました。

また宜しくお願い致します。