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

質問

皆様、宜しくお願い致します。
私はVBA歴が浅く初心者に近いため、何卒ご教示の程お願い申し上げます。

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

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

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

～動作させたいフロー～
(1)ユーザーフォーム画面上で該当するオプションボタン（キャプション）一つを選択し、テキストボックスにテキストを入力して
(2)「確定保存」のコマンドボタンをクリックすると
(3)バックグラウンドで「ご意見箱.xlsx」の「sheet1」をファイルオープンさせて
(4)「ご意見箱.xlsx」の「sheet１」の最終行（新規行）を取得して
(5)A列の最終行（新規行）の「No.」欄に自動で連番を入力させて
(6)C列の最終行（新規行）にオプションボタン（キャプション）内容を反映させ、D列も同じく最終行（新規行）にテキストボックスの内容を反映させて
(7)そのまま自動で上書き保存させてファイルを閉じさせる。
(8)もし、オプションボタン（キャプション）の未選択やテキストボックスの未入力があった場合は、入力を促すメッセージを表示させる。

～上記フローのように動作させるためのソース～
Private Sub CommandButton_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.TextBox = "" Then
MsgBox "ご意見入力欄を入力して下さい。m(_ _)m"
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 "所属部署を選択して下さい。m(_ _)m"
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.TextBox.Text
End With

tBk.Save
tBk.Close
Application.ScreenUpdating = True

End Sub

～現状で困っている点～
現状では、フローで云うところの(2)と(8)の部分は動作しているのですが、(3)～(7)の部分で動作しないため、つまづいている状況です。

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

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

諸先輩方からの大変貴重なアドバイスを賜り、それをベースにに自助努力でトライ＆エラーを繰り返してきたのですが、もし具体的にお分かりになる方がいらっしゃいましたら、皆様からご教示賜りたく何卒宜しくお願い申し上げます。（拝）

回答No.2

kagakusuki · ベストアンサー

設定しなければならない事が多い上に、使用するモジュールも複数に亘っていて、しかもそれぞれのモジュールに書き込まねばならない記述も長くなるため、回答文が非常に長い長文になります。
　そして、このサイトの回答欄は4000文字までしか入力する事が出来ないため、1回の投稿で全てをお伝えする事が出来ませんので、何度かに分けて回答させて頂きます。

　まず、「ユーザーフォーム.xlsm」のファイルを開いて下さい。
　次に、Excelウィンドウの上の方に並んでいるタブの中から[開発]タブを選択してクリックして下さい。
　次に、現れた「コード」グループの中にある[Visual Basic]ボタンをクリックして下さい。
　すると「Microsoft Visual Basic for Application」のウィンドウが開きますので、その中の左側にある「プロジェクト - VBAProject」ウィンドウの中に並んでいる現在開いているExcelbookのプロジェクトの中から「ユーザーフォーム.xlsm」プロジェクトを選択して右クリックして下さい。
　すると幾つかの選択肢が並んだメニューが現れますので、その中から[挿入]を選択してクリックして下さい。
　すると更なる選択肢が現れますので、その中から[標準モジュール]を選択してクリックして下さい。
　次に、「ユーザーフォーム.xlsm」プロジェクトの下に[標準モジュール]というフォルダーと、更にその下に「Module1」モジュールが現れた事を確認して下さい。
　次に、「ユーザーフォーム.xlsm」プロジェクトを再度右クリックして下さい。
　すると幾つかの選択肢が並んだメニューが現れますので、その中から[挿入]を選択してクリックして下さい。
　すると更なる選択肢が現れますので、その中から[ユーザーフォーム]を選択してクリックして下さい。
　次に、「ユーザーフォーム.xlsm」プロジェクトの下に[フォーム]というフォルダーと、更にその下に「UserForm1」モジュールが現れた事を確認して下さい。
　次に、「UserForm1」モジュールを選択して右クリックし、現れた選択肢の中から[オブジェクトの表示]を選択してクリックして下さい。
　すると「Microsoft Visual Basic for Application」のウィンドウ内の右側に「UserForm1」が表示されます。
　その「UserForm1」を右クリックし、現れた選択肢の中から[プロパティ]を選択してクリックして下さい。
　すると「プロパティ」ウィンドウが現れますので、その中にあるフォームの「Locked」プロパティの値を「Fals」に、「Enabled」プロパティプロパティの値を「True」にそれぞれ設定して下さい。(この設定をしないとそのユーザーフォームを呼び出して使用する際に、ユーザーフォームを操作する事が出来なくなります)
　次に、フォームの「(オブジェクト名)」プロパティの設定値を「UserForm1」から「Opinion_Box」に変更して下さい。(もし他にもユーザーフォームを設ける様な事があった場合に備えて他のフォームとの区別をつけやすくするため)
　次に、フォームの「Caption」プロパティの値を「意見箱入力フォーム」に設定して下さい。
　次に、フォームの「BackColor」プロパティ欄をクリックすると現れる[▼]ボタンをクリックして下さい。
　すると[パレット]と[システム]という2つのタブがあるダイアログボックスが現れますので、[パレット]タブの方をクリックし、現れた色のサンプルの中からフォームを塗りつぶしたい色(青)を選択してクリックして下さい。

　次に、「Microsoft Visual Basic for Application」のウィンドウの「メニュー」バーの[表示]ボタンをクリックし、現れた選択肢の中から[ツーボックス]を選択してクリックして下さい。
　すると「ツーボックス」ウィンドウが現れますので、その中にある[オプション ボタン]のボタンをクリックしてから、ユーザーフォーム上でオプションボタンを配置したい位置をクリックする事で、ユーザーフォームにオプションボタンを(1個だけ)配置して下さい。
　次に、そのフォーム上に配置したオプションボタンをクリックし、「プロパティ」ウィンドウ内の「(オブジェクト名)」プロパティの値が「OptionButton1」に変わった事を確認してから、(部署名を選択するといった共通の用途に使用するオプションボタンの組ごとに)「GroupName」プロパティの欄に例えば「DepartmentSelect」等の共通する設定値を入力して下さい。
　同様に、そのフォーム上に配置したオプションボタンの「Locked」プロパティの値を「Fals」に、「Enabled」プロパティプロパティの値を「True」にそれぞれ設定して下さい。(この設定をしないとオプションボタンにチェックを入れる事が出来ません)
　次に、オプションボタンの右側に部署名を表示する事が出来るだけのスペースを確保するために、そのフォーム上に配置したオプションボタンをクリックした際にその輪郭線の中点と端点の所に現れる表れる白点の内、適当なものにカーソルを合わせ、マウスの左ボタンのドラッグ＆ドロップを使ってオプションボタンのサイズを調整して下さい。
　或は、「height」プロパティと「Widh」プロパティの設定値を変更する事でオプションボタンのサイズを調整して下さい。
　次に、「Font」プロパティ欄をクリックするとその右端の位置に現れる[...]ボタンをクリックしますと、「フォント」ダイアログボックスが現れますので、そのダイアログボックスを使って「部署名を表示するフォント」の設定を行い、設定し終えてから「フォント」ダイアログボックスの[OK]ボタンをクリックして下さい。
　これらの設定を終えたオプションボタンにカーソルを合わせてからマウスの右ボタンを押しっ放しにし、そのままカーソルを適当な位置に移動させてから右ボタンを放しますと、選択肢のメニューが現れますのでその中から[この位置へコピー]を選択してクリックして下さい。
　すると元のオプションボタンをコピーしたオプションボタンが作成されますので、同様の操作を繰り返して部署の数だけオプションボタンを作成して下さい。
　尚、その際にはマウスの範囲選択を使ってボタン等のオブジェクトを複数選択する事も可能です。([Shift]キーや[Ctrl]キーを使った複数選択も可能です) その複数選択を解除する際には、そのユーザーフォームの中で、それらの複数選択に含まれていない部分をクリックして下さい。
　次に、それらのオプションボタンの位置をマウスの左ボタンのドラッグ＆ドロップを使って調節して下さい。
　その様にしてオプションボタンを縦横に配置し終えたら、その中で一番上の横一列に並んでいるオプションボタンをマウスの範囲選択を使って複数選択して下さい。
　その上で「BackCollar」プロパティ欄をクリックするとその右端の位置に現れる[▼]ボタンをクリックして下さい。
　すると[パレット]と[システム]という2つのタブがあるダイアログボックスが現れますので、[パレット]タブの方をクリックし、現れた色のサンプルの中からその横一列のオプションボタンに付けたい背景色を選択してクリックして下さい。
　続いて上から2列目、3列目・・・のオプションボタンに対しても同様の操作を行って、色を設定して下さい。
　因みに、「BackCollar」プロパティ欄の代わりに「ForeCollar」プロパティ欄で同様の操作を行えば、文字色の設定を行う事が出来ます。
　次に、それらのオプションボタンを1つずつ選択して行き、その各々の「Caption」プロパティ欄に「ボタンの横に表示させたい部署名」を入力して下さい。

※まだ途中なのですが、先述しました様にこのサイトの回答欄に入力可能な文字数は4000文字しかなく、これ以上書き込みを続けますと切りの悪い所で区切らねばなりませんので、残りはまた後で投稿させて頂きます。

お礼

kagakusuki 様へ

kagakusuki 様から頂戴しました他の回答にも「お礼」をさせて頂きます。

このNo.2の回答を拝見した時にいろいろなケースごとの制御処理も考えなければならないと痛感しました。
私はそこまで深く考えていなかったのですが、今回の質問を機にとても勉強になりました。

この度は、本当に有難うございました。

回答No.8

kagakusuki

>「確定する」ボタンをクリックすると、以下のエラーメッセージが表示されてしまいます。

>【エラー内容】
------------------------------------------------------------
>実行時エラー'424':
>オブジェクトが必要です。
------------------------------------------------------------

>そのまま、「デバッグ」ボタンをクリックすると、回答No.5で頂戴した『[確定する]ボタンをクリックした時の処理』におけるVBA構文内で、
>myText = Contents_of_posting.Value
>の箇所が黄色く示されております。
>この原因を自分でいろいろと調べてみたところ、Variant型で宣言している変数だということと、ご意見入力欄のテキストボックスに関しての制御の構文である ということ、そして".Value"の部分で引っ掛かっているのではないか・・・？

　申し訳御座いません。

>Variant型で宣言している変数

であるという点は、間違いなどではなく、別段トラブルの原因となる様なものでは御座いません。
　原因は、回答No.3における設定操作方法に関する私の説明に抜けがあった事によるものです。

myText = Contents_of_posting.Value

という部分は、
「『Contents_of_posting』という名称が付けられているオブジェクトの『Valueプロパティの値』をmyTextという変数名が付けられている変数に格納する」
という処理を行わせる構文です。
　しかし、回答No.2から6にかけての操作方法の中には、どこにも
「何かのオブジェクトに対して『Contents_of_posting』という名称を付ける」
という類の事を行う様に指示している箇所がありません。
　そのため、そのままでは「『Contents_of_posting』という名称が付けられているオブジェクト」が存在していない事になりますから、Contents_of_posting.Valueの値を取り扱う様な構文に差し掛かった時に

>オブジェクトが必要です。

というエラーが出てしまった訳です。
　それでは変数myTextに格納したContents_of_posting.Valueの値とは何かと申しますと、『[確定する]ボタンをクリックした時の処理』におけるVBA構文内のもっと後の所に記されている

.Range(TextColumn & PostRow).Value = myText

という箇所において、変数myTextに格納されている値を、「ご意見箱xlsx」Bookの.Range(TextColumn & PostRow)セルに入力しています。
　そして定数TextColumnとは

>Const TextColumn As String = "D" '転記先のシートにおいて投書内容を転記する列の列番号

の事なのですから、変数myTextに格納したContents_of_posting.Valueの値とは、「投書内容」でなければならないという事になります。
　本件の「投書内容」はテキストボックスに書き込まれるものなのですから、Contents_of_posting.Valueの値も「テキストボックスの値」即ち「テキストボックスに書き込まれた内容」の事でなければなりませんので、「『Contents_of_posting』という名称が付けられているオブジェクト」とはユーザーフォーム上に配置されたテキストボックスの名称でなければなりません。

　ですから、解決方法は以下の様なものになります。
　まず、「ユーザーフォーム.xlsm」のファイルを開いて下さい。
　次に、Excelウィンドウの上の方に並んでいるタブの中から[開発]タブを選択してクリックして下さい。
　次に、現れた「コード」グループの中にある[Visual Basic]ボタンをクリックして下さい。
　すると「Microsoft Visual Basic for Application」のウィンドウが開きますので、その中の左側にある「プロジェクト - VBAProject」ウィンドウの中に並んでいる現在開いているExcelbookのプロジェクトの中の「ユーザーフォーム.xlsm」プロジェクトの下位に存在する「フォーム」フォルダー内にある[Opinion_Box]を選択して右クリックして下さい。
　すると幾つかの選択肢が並んだメニューが現れますので、その中から[オブジェクトの表示]を選択してクリックして下さい。
　すると「Opinion_Box」のユーザーフォームが表示されますので、その中にあるご意見入力用のテキストボックスを右クリックして下さい。
　すると幾つかの選択肢が並んだメニューが現れますので、その中から[プロパティ]を選択してクリックして下さい。
　するとそのテキストボックスの「プロパティ」ウィンドウが現れますので、その中にある「(オブジェクト名)」欄に

Contents_of_posting

と入力して下さい。

　そうすれば

myText = Contents_of_posting.Value

の箇所における

>実行時エラー'424':
>オブジェクトが必要です。

というエラーは出なくなる筈ですので、その設定が消えない様に「ユーザーフォーム.xlsm」のファイルを上書き保存して下さい。

お礼

kagakusuki 様へ

この度は、大変お世話になっております。
お忙しい中、丁寧なご返信を下さり、ありがとうございます。

kagakusuki 様のお陰様をもちまして、エラーの対処とすべての動作において思ったとおりに動作したことの確認ができ、これにて全てが解決致しました。

kagakusuki 様のご回答はとてもわかりやすく、且つ数回に亘って解説文を交えて頂きながら一回一回丁寧なご回答であり、さらに的を得た非常にクオリティ（精度）のあるご回答内容でして、kagakusuki 様からご回答を頂けて本当に良かったでした。

御礼のしようもございません。真に有難うございました。

せっかくこの場でご教授頂きましたので、今回の題材でもう一度VBA構文をおさらいして、処理の流れや仕組み、構文を読む力と書く力を付けていきたいと思っております。

またこれからもご縁がございましたら、何卒宜しくお願い申し上げます。

この度は、最後までお付き合いくださり、本当に有難うございました。（拝）

回答No.7

kagakusuki

回答No.2、3、4、5、6です。
　ここまでの私の回答の中に幾つかの誤記がありましたので御報告致します。

　回答No.2において

「Widh」プロパティ

と記されている箇所がありますが、これは

「Width」プロパティ

の間違いです。

　同じく回答No.2において

「Fals」

と記されている箇所がありますが、これは

「False」

の間違いです。

　回答No.4において

「ThisWorkbook」モジュールを選択してダブルクリックして下さい。
　次に、「Microsoft Visual Basic for Application」のウィンドウ内の右側の欄内にある「Private Sub Opinion_Box_Open()」の構文に続けて次のVBAの構文を入力して下さい。

と記されている箇所がありますが、「Private Sub Opinion_Box_Open()」の構文が記されいるのは「ThisWorkbook」モジュールではなく「Module1」モジュールであるのに対し、「Private Sub Workbook_Open()」を書き込むのは「ThisWorkbook」モジュールで間違いありませんので、

>「Private Sub Opinion_Box_Open()」の構文に続けて

というのは間違いです。
　ですから正しくは

「ThisWorkbook」モジュールを選択してダブルクリックして下さい。
　次に、「Microsoft Visual Basic for Application」のウィンドウ内の右側の欄内に次のVBAの構文を入力して下さい。

です。

お礼

kagakusuki 様へ

この度は、大変お世話になっております。
kagakusuki 様のお陰ではじめから一通り再構築をさせていただきました。
解説文を交えて頂きながらのとてもわかりやすい丁寧なご回答を下さり、真に有難うございます。
本当に勉強になりました。
少しずつではありますが、全体の動作についてのロジックがわかるようになってきました。

そこで、一点だけエラーについてのご質問なのですが、
動作確認をした際、ユーザーフォームで所属部署の選択とご意見の内容をテキスト入力して
最後に「確定する」ボタンをクリックすると、以下のエラーメッセージが表示されてしまいます。

【エラー内容】
------------------------------------------------------------
実行時エラー'424':
オブジェクトが必要です。
------------------------------------------------------------

そのまま、「デバッグ」ボタンをクリックすると、回答No.5で頂戴した
『[確定する]ボタンをクリックした時の処理』におけるVBA構文内で、
myText = Contents_of_posting.Value
の箇所が黄色く示されております。

この原因を自分でいろいろと調べてみたところ、Variant型で宣言している変数
だということと、ご意見入力欄のテキストボックスに関しての制御の構文である
ということ、そして".Value"の部分で引っ掛かっているのではないか・・・？
というところまではわかりましたが、具体的にどのようにしたら解決できるか
辿り着けませんでした。

何度もお手数をお掛けし、大変恐縮至極ではございますが、
ご教授の程お願い申し上げます。

補足

kagakusuki様へ
この度は、数回に亘り貴重なお時間を割いて頂きながら、こんなにも懇切丁寧にレクチャーしてくださり、本当にありがとうございます。
質問を出して以降、急遽出張が入りまして、お返事が遅くなってしまい至極恐縮です。
まだ出張から帰ってきておりませんので、頂戴した内容を取り組めてはおりませんが、回答内容を読んでいて、かなりイメージできました。
しかも、私みたいな初心者に対して、かゆいところに手が届くようなご回答且つ的を得た内容でして、本当に感謝感謝です。
また出張が終わり次第、取り組んでみようと思っております。
まずはこの場での御礼をお伝え致しますとともに、また正式に『お礼』の方もさせて頂きます。

回答No.6

kagakusuki

回答No.5の続きです。

　次に、引き続き「ユーザーフォーム.xlsm」Bookの「フォーム」フォルダーの下にある「Opinion_Box」モジュール上での作業を行い、前述の「Private Sub ConfirmButton_Click()」プロシージャの構文の末尾にある

End Sub

よりも下の行に(数行空けて)続けて下記のVBAの構文を入力して下さい。

'[入力内容消去]ボタンをクリックした時の処理
Private Sub ResetButton_Click()

If MsgBox("意見入力フォームの記入内容を消去し、フォームをリセットします。" _
& vbCrLf & "よろしいですか?" & vbCrLf & vbCrLf _
& "[OK] : 記入内容を消去し、フォームをリセットします" _
& vbCrLf & "[キャンセル] : 記入内容の消去を取り止めます" _
, vbOKCancel + vbInformation, "記入内容クリア") = vbOK _
Then Call FormReset

End Sub

'入力内容を消去する処理
Private Sub FormReset()

Dim co As Control

For Each co In Me.Controls
Select Case TypeName(co)
Case "CheckBox", "OptionButton"
co.Value = False
Case "TextBox"
co.Value = ""
End Select
Next co

End Sub

'[キャンセル]ボタンをクリックした時の処理
Private Sub CancelButton_Click()

Unload Me

End Sub

'ユーザーフォームを閉じた時の処理
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

Dim myInformation As String

Select Case MsgBox("意見入力フォームを終了します。" & vbCrLf _
& "このExcelBookも同時に閉じても宜しいですか？" & vbCrLf & vbCrLf _
& "[はい] : 意見入力フォームとこのExcelBookの両方を閉じます" & vbCrLf _
& "[いいえ] : 意見入力フォームは閉じますが、このBookは閉じません" _
& vbCrLf & "[キャンセル] : 意見入力フォームへの入力を続行します" _
, vbYesNoCancel + vbInformation + vbDefaultButton2, "確認")
Case vbYes
Cancel = False
ThisWorkbook.Close
Case vbNo
Cancel = False
Case Else
Cancel = True
If MsgBox("意見入力フォームの記入内容を消去し、フォームをリセットしますか?" _
& vbCrLf & vbCrLf & "[はい] : 記入内容を消去し、フォームをリセットします" _
& vbCrLf & "[いいえ] : 記入内容はそのまま残します" _
, vbYesNo + vbQuestion + vbDefaultButton2, "確認") = vbYes Then Call FormReset
End Select

End Sub

　以上です。

　尚、

>(7)そのまま自動で上書き保存させてファイルを閉じさせる。

に関してですが、「意見箱入力フォーム」フォームを起動させる前に既に「ご意見箱.xlsx」を開いていた場合には、その開いていた「ご意見箱.xlsx」のウィンドウ自体は開いたままにする様になっております。

　それから、「ご意見箱.xlsx」が保存されている事になっているフォルダーのパスと同じパスを持つフォルダーが存在しなかった場合や、
「ご意見箱.xlsx」が保存されている事になっているフォルダーの中に「ご意見箱.xlsx」が保存されていない場合、
「意見箱入力フォーム」の入力内容を反映させるシートとして設定されている「Sheet1」というシート名のシートが「ご意見箱.xlsx」Bookの中に存在しなかった場合、
「ご意見箱.xlsx」と同名のファイルで、保存されているフォルダーが異なる別のExcelファイルが開かれている最中で、本来の「ご意見箱.xlsx」Bookを開く事が出来ない場合、
には、「意見箱入力フォーム」の入力内容を保存する事が出来ませんから、その様な場合は「意見箱入力フォーム」フォームを開こうとした際や、「確定する」ボタンを押した際に警告文を表示する様になっています。

お礼

kagakusuki 様へ

kagakusuki 様から頂戴しました他の回答にも「お礼」をさせて頂きます。

この度は、本当に有難うございました。

補足

kagakusuki 様へ

この度は、大変お世話になっております。
はじめから一通り再構築をさせていただきました。
解説文を交えて頂きながらのとてもわかりやすい丁寧なご回答を下さり、真に有難うございます。
お陰様で本当に勉強になりました。
少しずつではありますが、全体の動作についてのロジックがわかるようになってきました。

そこで、一点だけエラーについてのご質問なのですが、
動作確認をした際、ユーザーフォームで所属部署の選択とご意見の内容をテキスト入力して
最後に「確定する」ボタンをクリックすると、以下のエラーメッセージが表示されてしまいます。

【エラー内容】
------------------------------------------------------------
実行時エラー'424':
オブジェクトが必要です。
------------------------------------------------------------

そのまま、「デバッグ」ボタンをクリックすると、回答No.5で頂戴した
『[確定する]ボタンをクリックした時の処理』におけるVBA構文内で、
myText = Contents_of_posting.Value
の箇所が黄色く示されております。

この原因を自分でいろいろと調べてみたところ、Variant型で宣言している変数
だということと、ご意見入力欄のテキストボックスに関しての制御の構文である
ということ、そして ”.Value”の部分で引っ掛かっているのではないか・・・？
というところまではわかりましたが、具体的にどのようにしたら解決できるか
辿り着けませんでした。

何度もお手数をお掛けし、大変恐縮至極ではございますが、
ご教授の程お願い申し上げます。

回答No.5

kagakusuki

回答No.4の続きです。

　次に、「プロジェクト - VBAProject」ウィンドウの中に並んでいるモジュールの中から、現在開いている「ユーザーフォーム.xlsm」Bookの「フォーム」フォルダーの下にある「Opinion_Box」モジュールを選択して右クリックして下さい。
　すると幾つかの選択肢が現れますので、その中から[コードの表示]を選択してクリックして下さい。
　次に、「Microsoft Visual Basic for Application」のウィンドウ内の右側の欄内に次の2つのVBAの構文を入力して下さい。

'ユーザーフォームを開いた時の処理(フォームの説明文を表示)
Private Sub UserForm_Activate()

MsgBox "(1)の「所属部署選択」欄で所属部署を選択し、" _
& vbCrLf & "(2)の「御意見入力欄」に御意見を入力してから、" _
& vbCrLf & "(3)の[確定する]ボタンをクリックして下さい。" _
& vbCrLf & "　(御入力された内容が別の場所に保存されます)" _
& vbCrLf & vbCrLf & vbCrLf _
& "※1　[入力内容消去]ボタンをクリックするか、" _
& "フォームを閉じますと入力した内容を消去する事が出来ます。" _
& vbCrLf & "　(消えるのはフォームに表示されている内容だけで、" _
& "一旦投函された投書内容は別の場所に保存されたままです)" _
& vbCrLf & vbCrLf & "※2　[キャンセル]ボタンを使用しますと" _
& "入力を中止してフォームを閉じることができます。" _
, vbInformation, "「御意見箱入力フォーム」使用方法"

End Sub

'[確定する]ボタンをクリックした時の処理
Private Sub ConfirmButton_Click()

Const NumberColumn As String = "A" '転記先のシートにおいて連番を記入する列の列番号
Const DateColumn As String = "B" '転記先のシートにおいて意見が投書された日付を記入する列の列番号
Const DepartmentColumn As String = "C" '転記先のシートにおいて所属部署名を転記する列の列番号
Const TextColumn As String = "D" '転記先のシートにおいて投書内容を転記する列の列番号
Const myGroupName As String = "DepartmentSelect" '所属部署選択用のオプションボタンのGroupNameプロパティに設定した値
Dim StoragePath As String, PostFileName As String, PostSheetName As String _
, Department As String, myText As String, PostBook As Workbook _
, PostRow As Long, PostingOK As Boolean, myWindow As Window _
, buf As Variant, co As Control, myInformation As String

Department = "": myText = ""
For Each co In Opinion_Box.Controls
If TypeName(co) = "OptionButton" Then
If co.Value = True And co.GroupName = "DepartmentSelect" Then _
Department = co.Caption
End If
Next co
myText = Contents_of_posting.Value

myInformation = ""
If Department = "" Then myInformation = "所属部署 "
If myText = "" Then myInformation = myInformation & "ご意見本文"
myInformation = Replace(RTrim(myInformation), " ", "と")
If myInformation = "" Then

Select Case MsgBox("下記の内容が入力されています。" & vbCrLf _
& "この内容で「ご意見箱」に投書して宜しいですか？" & vbCrLf _
& "　[はい] : この内容で「ご意見箱」に投書します" & vbCrLf _
& "　[いいえ] : 入力フォームに戻って投書内容を修正します" & vbCrLf _
& "　[キャンセル] : 投書を中止して入力フォームを閉じます" _
& vbCrLf & vbCrLf & "【所属部署】 " & Department _
& vbCrLf & vbCrLf & "【ご 意 見】 " & vbCrLf & myText _
, vbYesNoCancel + vbInformation, "投書内容確認")
Case vbYes
GoTo Label_Posting
Case vbCancel
Unload Me
End Select
Exit Sub

Else
If MsgBox( _
myInformation & "が入力されていません。" & vbCrLf & vbCrLf _
& "[再試行] : フォームへの入力に戻ります" & vbCrLf _
& "[キャンセル] : 入力を中止し、フォームを閉じます" _
, vbRetryCancel + vbExclamation, "未入力項目あり") _
= vbCancel Then Unload Me
Exit Sub
End If

Label_Posting:
myInformation = vbCrLf _
& "フォームにご入力いただいた内容を投函することができません。"
Call Confirm_posting_place(myInformation, PostingOK _
, StoragePath, PostFileName, PostSheetName)

With Application
.ScreenUpdating = False
.Calculation = xlManual
.DisplayAlerts = False
End With

buf = ""
On Error Resume Next
Set PostBook = Windows(PostFileName).Parent
buf = PostBook.Path
On Error GoTo 0
If buf = StoragePath Then
Set myWindow = PostBook.Windows(1).NewWindow
Else
Set PostBook = Workbooks.Open(StoragePath & "\" & PostFileName)
Set myWindow = PostBook.Windows(1)
End If
myWindow.Visible = False
With PostBook
.Windows(.Windows.Count).Visible = False
ThisWorkbook.Activate
With .Sheets(PostSheetName)
PostRow = 0
PostRow = .Range(DateColumn & .Rows.Count).End(xlUp).Row + 1
.Range(NumberColumn & PostRow).Value _
= Int(WorksheetFunction.Max(.Columns(NumberColumn))) + 1
With .Range(DateColumn & PostRow)
.Value = Date
.NumberFormatLocal = "ggge""年""m""月""d""日""(aaa)"
End With
.Range(DepartmentColumn & PostRow).Value = Department
.Range(TextColumn & PostRow).Value = myText
End With
End With

With myWindow
.Visible = True
.Parent.Save
.Close
End With
ThisWorkbook.Activate

With Application
.Calculation = xlAutomatic
.ScreenUpdating = True
.DisplayAlerts = True
End With

MsgBox "「ご意見箱」への投函が完了しました。", vbInformation, "完了"
Unload Me

End Sub

※まだ途中なのですが、そろそろこのサイトの回答欄の文字数制限を超えそうですので、残りはまた後で投稿させて頂きます。

お礼

kagakusuki 様へ

kagakusuki 様から頂戴しました他の回答にも「お礼」をさせて頂きます。

私の場合、このNo.４以降の内容のついて理解を深めていかないといけないなと感じました。
ここで学ばせて頂いた手法を今後の参考にさせて頂きます。

この度は、本当に有難うございました。

回答No.4

kagakusuki

回答No.3の続きです。

　次に、「プロジェクト - VBAProject」ウィンドウの中に並んでいるモジュールの中から、現在開いている「ユーザーフォーム.xlsm」Bookの「Module1」モジュールを選択してダブルクリックして下さい。
　次に、「Microsoft Visual Basic for Application」のウィンドウ内の右側の欄内にある「Private Sub Opinion_Box_Open()」プロシージャの構文の末尾にある

End Sub

よりも下の行に(数行空けて)続けて下記のVBAの構文を入力して下さい。
　尚、下記のVBAの構文中にある変数「StoragePath」の値(転記先のファイルが存在するフォルダーのパス)として設定されている

C:\Users\(ユーザー名)\Documents

というパスは仮のものに過ぎませんので、実際に使用される際には「ご意見箱.xlsx」のファイルが実際に保存されているフォルダーのパスに合わせて修正して下さい。
　それから、下記の「Confirm_posting_place」マクロは、Callステートメントを使って他のモジュールとの間で値のやり取りを行うためのものなのですが、もしこれを「Sub」ではなく「Private Sub」で始まる様にしてしまいますと、「Private Sub」で始まるプロシージャは他のモジュールから"Callステートメントでは"呼び出す事が出来なくなってしまいますので、うっかり「Private Sub」で始まる形式にする事がないよう注意して下さい。

'ユーザーフォームに入力された投書データの転記先の有無を確認
'及び転記先Bookを開く事が可能な状況かどうかの確認
Sub Confirm_posting_place( _
ByVal myInformation As String, _
ByRef PostingOK As Boolean, _
ByRef StoragePath As String, _
ByRef PostFileName As String, _
ByRef PostSheetName As String)

Dim buf As Variant

StoragePath = "C:\Users\(ユーザー名)\Documents" '転記先のファイルが存在するフォルダーのパス
PostFileName = "ご意見箱.xlsx" '転記先のファイルのファイル名
PostSheetName = "Sheet1" '転記先のファイル上の転記先のシートのシート名

buf = ""
On Error Resume Next
buf = Windows(PostFileName).Caption
On Error GoTo 0
If buf = PostFileName Then
PostingOK = Windows(PostFileName).Parent.Path = StoragePath
Else
PostingOK = True
End If
If Dir(StoragePath, vbDirectory) = "" Then
PostingOK = False
MsgBox "「ご意見箱」の投書内容の保存先のファイルがあるフォルダーとして" _
& "設定されているフォルダーが見当たらないため、" & myInformation _
& vbCrLf & vbCrLf & "「ご意見箱」を利用される方は、このトラブル内容を" _
& "「ご意見箱」の管理責任者に報告して対応してもらうようにして下さい。" _
, vbExclamation, "《トラブル報告》保存先ファイル不明"
ElseIf Dir(StoragePath & "\" & PostFileName) = "" Then
PostingOK = False
MsgBox "「ご意見箱」の投書内容の保存先のファイルとして設定されている" _
& vbCrLf & vbCrLf & PostFileName & vbCrLf & vbCrLf & _
"が所定のフォルダー内には見当たらないため、" & myInformation _
& vbCrLf & vbCrLf & "「ご意見箱」を利用される方は、このトラブル内容を" _
& "「ご意見箱」の管理責任者に報告して対応してもらうようにして下さい。" _
, vbExclamation, "《トラブル報告》保存先フォルダー不明"
Else
buf = Chr(0)
On Error Resume Next
buf = ExecuteExcel4Macro("'" & StoragePath _
& "\[" & PostFileName & "]" & PostSheetName & "'!R65536C256")
On Error GoTo 0
If buf = Chr(0) Then
PostingOK = False
MsgBox "「ご意見箱」の投書内容の保存先として設定されている" _
& vbCrLf & vbCrLf & PostFileName & vbCrLf & vbCrLf & _
"というExcelBookの中には、投書内容の転記先として設定されている" _
& vbCrLf & vbCrLf & PostSheetName & vbCrLf & vbCrLf & _
"というシート名のシートが見当たらないため、" & myInformation _
& vbCrLf & vbCrLf & "「ご意見箱」を利用される方は、このトラブル内容を" _
& "「ご意見箱」の管理責任者に報告して対応してもらうようにして下さい。" _
, vbExclamation, "《トラブル報告》保存先シート不明"
ElseIf Not PostingOK Then
Windows(PostFileName).Activate
MsgBox "「ご意見箱」の投書内容の保存先のExcelBookとして設定されている" _
& vbCrLf & vbCrLf & PostFileName & vbCrLf & vbCrLf & _
"と同名の別Book(保存先フォルダーが異なるBook)が開いているため、 " _
& myInformation & vbCrLf & vbCrLf _
& "「ご意見箱」を利用される場合には、現在開かれている" & vbCrLf & vbCrLf _
& Left(PostFileName, InStrRev(PostFileName, ".") - 1) & vbCrLf & vbCrLf & _
"というWindowのExcelBookを閉じても問題がないか否かを確認し、" _
& "特に問題がない場合には、そのWindowのExcelBookを閉じてから、" _
& "このフォームを開きなおして下さい。" _
, vbExclamation, "保存先ファイルへのアクセス不能"
End If
End If

End Sub

　次に、「プロジェクト - VBAProject」ウィンドウの中に並んでいるモジュールの中から、現在開いている「ユーザーフォーム.xlsm」Bookの「ThisWorkbook」モジュールを選択してダブルクリックして下さい。
　次に、「Microsoft Visual Basic for Application」のウィンドウ内の右側の欄内にある「Private Sub Opinion_Box_Open()」の構文に続けて次のVBAの構文を入力して下さい。

'このExcelファイルを開いた時に行う処理
Private Sub Workbook_Open()

On Error Resume Next
Sheets("Sheet1").Activate '[意見入力フォームを開く]ボタンがあるシートを開く
On Error GoTo 0
Application.Run "Opinion_Box_Open"

End Sub

※まだ途中なのですが、先述しました様にこのサイトの回答欄に入力可能な文字数は4000文字しかなく、これ以上書き込みを続けますと切りの悪い所で区切らねばなりませんので、残りはまた後で投稿させて頂きます。

お礼

kagakusuki 様へ

kagakusuki 様から頂戴しました他の回答にも「お礼」をさせて頂きます。

この度は、本当に有難うございました。

回答No.3

kagakusuki

回答No.2の続きです。

　次に、「ツールボックス」ウィンドウの中にある[テキスト ボックス]のボタンをクリックしてから、ユーザーフォーム上で「テキストボックスを配置したい位置の左上の隅の位置」から「テキストボックスを配置したい位置の右下の隅の位置」にかけてマウスの左ボタンを使ったドラッグ＆ドロップを行う事で、ユーザーフォームにテキストボックスを配置して下さい。
　次に、そのフォーム上に配置したテキストボックスをクリックし、「プロパティ」ウィンドウ内の「(オブジェクト名)」プロパティの値が「TextBox1」に変わった事を確認してから、「Locked」プロパティの値を「False」に、「Enabled」プロパティプロパティの値を「True」にそれぞれ設定して下さい。(この設定をしないとテキストボックスに文章を入力する事が出来ません)
　同様に「WordWrap」プロパティと「MultiLine」プロパティの値を共に「True」に設定して下さい。(この設定をする事でテキストボックス内に入力した文字列の表示を「折り返して全体を表示する」にする事が出来ます)
　同様に「ScrollBars」プロパティの値を「2-fmScrollBarsVertical」か「3-fmScrollBarsBoth」に設定して下さい。(この設定をする事でテキストボックスに縦スクロールバーが現れる様になりますので、長文を入力した際の編集・確認作業が楽になります)
　次に、「Font」プロパティ欄をクリックするとその右端の位置に現れる[...]ボタンをクリックしますと、「フォント」ダイアログボックスが現れますので、そのダイアログボックスを使って「テキストボックスに入力された文字列を表示するフォント」の設定を行い、設定し終えてから「フォント」ダイアログボックスの[OK]ボタンをクリックして下さい。
　次に、フォーム上に配置したテキストボックスをクリックした際にその輪郭線の中点と端点の所に現れる表れる白点の内、適当なものにカーソルを合わせ、マウスの左ボタンのドラッグ＆ドロップを使ってテキストボックスのサイズや位置を調整して下さい。

　次に、「ツールボックス」ウィンドウの中にある[コマンド ボタン]のボタンをクリックしてから、ユーザーフォーム上でコマンドボタンを配置したい位置をクリックする事で、ユーザーフォームにコマンドボタンを(1個だけ)配置して下さい。
　次に、そのフォーム上に配置したコマンドボタンをクリックし、「プロパティ」ウィンドウ内の「(オブジェクト名)」プロパティの値が「CommandButton1」に変わった事を確認してから、「Locked」プロパティの値を「False」に、「Enabled」プロパティプロパティの値を「True」にそれぞれ設定して下さい。(この設定をしないとコマンドボタンを押す事が出来ません)
　次に、コマンドボタン内に必要な文字列を表示する事が出来るだけのスペースを確保するために、そのフォーム上に配置したコマンドボタンをクリックした際にその輪郭線の中点と端点の所に現れる表れる白点の内、適当なものにカーソルを合わせ、マウスの左ボタンのドラッグ＆ドロップを使ってコマンドボタンのサイズを調整して下さい。
　或は、「height」プロパティと「Width」プロパティの設定値を変更する事でコマンドボタンのサイズを調整して下さい。
　次に、「Font」プロパティ欄をクリックするとその右端の位置に現れる[...]ボタンをクリックしますと、「フォント」ダイアログボックスが現れますので、そのダイアログボックスを使って「コマンドボタンに表示する文字列のフォント」の設定を行い、設定し終えてから「フォント」ダイアログボックスの[OK]ボタンをクリックして下さい。
　これらの設定を終えたコマンドボタンにカーソルを合わせてからマウスの右ボタンを押しっ放しにし、そのままカーソルを適当な位置に移動させてから右ボタンを放しますと、選択肢のメニューが現れますのでその中から[この位置へコピー]を選択してクリックして下さい。
　すると元のコマンドボタンをコピーしたコマンドボタンが作成されますので、同様の操作をもう一度繰り返して計3個のコマンドボタンを作成して下さい。
　次に、それらのコマンドボタンの位置をマウスの左ボタンのドラッグ＆ドロップを使って調節し、フォームの右下の辺りに3個のコマンドボタンが横一列に並んでいる様にして下さい。
　次に、それらのコマンドボタンの内、左端にあるものをクリックし、「プロパティ」ウィンドウ内の「(オブジェクト名)」プロパティの値を「ConfirmButton」に、「Caption」プロパティの値を「確定する」にそれぞれ設定して下さい。
　次に、それらのコマンドボタンの内、中央にあるものをクリックし、「プロパティ」ウィンドウ内の「(オブジェクト名)」プロパティの値を「ResetButton」に、「Caption」プロパティの値を「入力内容消去」にそれぞれ設定して下さい。
　次に、それらのコマンドボタンの内、右端にあるものをクリックし、「プロパティ」ウィンドウ内の「(オブジェクト名)」プロパティの値を「CancelButton」に、「Caption」プロパティの値を「キャンセル」にそれぞれ設定して下さい。

　次に、「ツールボックス」ウィンドウの中にある[ラベル]のボタンをクリックしてから、ユーザーフォーム上でラベルを配置したい位置をクリックする事で、ユーザーフォームにラベルを必要な数だけ配置して下さい。
　次に、そのフォーム上に配置したラベルの内の1つをクリックし、「プロパティ」ウィンドウ内の「(オブジェクト名)」プロパティの値が「『Label』+数字」の形式の名称に変わった事を確認してから、「Enabled」プロパティの値を「True」に設定して下さい。(この設定をしないと文字色が灰色のままとなってしまいます)
　同様に「BackStyle」プロパティ欄の値を「0 - fmBackStyleTransparent」に設定して下さい。(この設定をする事でラベルオブジェクトの背景色が透明になります)
　同様に「AutoSize」プロパティ欄の値を「True」に設定して下さい。(この設定をする事で、ラベルオブジェクトのサイズが、そのラベルに設定した文字列に合わせて自動的にフィットする様になります)
　次に、「Caption」プロパティの値をそのラベルに表示させたい文字列に設定して下さい。
　次に、「Font」プロパティ欄をクリックするとその右端の位置に現れる[...]ボタンをクリックしますと、「フォント」ダイアログボックスが現れますので、そのダイアログボックスを使って「ラベルに表示させたい文字列のフォント」の設定を行い、設定し終えてから「フォント」ダイアログボックスの[OK]ボタンをクリックして下さい。
　次に、「ForeCollar」プロパティ欄をクリックすると現れる[▼]ボタンをクリックして下さい。
　すると[パレット]と[システム]という2つのタブがあるダイアログボックスが現れますので、[パレット]タブの方をクリックし、現れた色のサンプルの中からラベルの文字色にしたい色を選択してクリックして下さい。
　ユーザーフォーム上に配置した他のラベルに対しても同様の操作を行って下さい。

　これでユーザーフォーム"本体の"デザインは完了です。

　次に、「プロジェクト - VBAProject」ウィンドウの中に並んでいるモジュールの中から、現在開いているExcelbookの「Module1」モジュールを選択してダブルクリックして下さい。
　次に、「Microsoft Visual Basic for Application」のウィンドウ内の右側の欄内に次のVBAの構文を入力して下さい。

'ユーザーフォームを開く
Private Sub Opinion_Box_Open()

Const myInformation As String _
= "現在は「ご意見箱」を利用する事ができません。"
Dim PostRow As Long, buf As Variant _
, PostingOK As Boolean, Dummy(2) As String

Call Confirm_posting_place( _
myInformation, PostingOK, Dummy(0), Dummy(1), Dummy(2))
If PostingOK Then Opinion_Box.Show

End Sub

　次に、「ユーザーフォーム.xlsm」Bookの「Sheet1」シートを開いて下さい。
　次に、Excelウィンドウの上の方に並んでいるタブの中から[開発]タブを選択してクリックして下さい。
　すると現れる「コントロール」グループの中にある[挿入]ボタンをクリックし、現れた選択肢の中から[ボタン(フォーム コントロール)]のアイコンをクリックしてから、開いているシート上の適当なセルをクリックして下さい。
　すると「マクロの登録」ダイアログボックスが現れますので、その中の「マクロ名」欄に

Opinion_Box_Open

と入力してから「マクロの登録」ダイアログボックスの[OK]ボタンをクリックして下さい。

※まだ途中なのですが、そろそろこのサイトの回答欄の文字数制限を超えそうですので、残りはまた後で投稿させて頂きます。

お礼

kagakusuki 様へ

kagakusuki 様から頂戴しました他の回答にも「お礼」をさせて頂きます。

添付画像による完成イメージまでお見せくださり、とてもわかりやすいご回答を頂戴し感謝しております。

この度は、本当に有難うございました。

回答No.1

nan93850673

>(3)～(7)の部分で動作しない

動作しないという内容が、添付画像書いている「所属部署を選択して下さい。m(_ _)m」が出ることであれば、

>For i = 1 To 3 'オプションが連番になっているとして、最終番号まで
で、オプションボタンを最初の3個しか見ていないのが原因。

>(6)C列の最終行（新規行）にオプションボタン（キャプション）内容を反映させ
とあるのに

>.Cells(j + 1, "C") = i 'Me.Controls("OptionButton" & i).Caption
では、オプションボタンの番号をセットしていて、キャプションをセットする部分はコメントになっている。

とにかく、「動作しない」では何が起きているのか分からないから答えにくい。

お礼

nan93850673様

早速、ご回答くださり大変ありがとうございます。

>>>(3)～(7)の部分で動作しない
>>動作しないという内容が、添付画像書いている「所属部署を選択して下さい。m(_ _)m」が出ることであれば、

おっしゃるとおりです。

＞＞For i = 1 To 3 'オプションが連番になっているとして、最終番号までで、オプションボタンを最初の3個しか見ていないのが原因。

オプションボタンは、１７個ありますので、For i = 1 To 17に修正しました。

>>(6)C列の最終行（新規行）にオプションボタン（キャプション）内容を反映させとあるのに、
>>.Cells(j + 1, "C") = i 'Me.Controls("OptionButton" & i).Caption
では、オプションボタンの番号をセットしていて、キャプションをセットする部分はコメントになっている。

ここの構文は、具体的にどのような構文になるでしょうか？

>とにかく、「動作しない」では何が起きているのか分からないから答えにくい。

言葉足らずでした。上手く動作しない具体的な内容は以下のとおりです。

「オプションボタン１」を選択し、テキストボックス入力後に「確定保存」ボタンをクリックすると、
数字の「１」が反映されてしまい、キャプション名が反映されません・・・。

「オプションボタン２」以降を選択し、テキストボックス入力後に「確定保存」ボタンをクリックすると、
添付画像にあるとおり「所属部署を選択して下さい。m(_ _)m」が表示されてしまいます。

宜しくお願い致します。