Wordで穴埋め問題を作成したいときはないでしょうか。
例えば暗記のチェックのための問題作成や塾や家庭教師などでオリジナルの問題集を作りたいときなどです。
そんなときに悩ませることは、
・Wordで穴埋め問題を手作業でなく一括で作成したいが方法がわからない。
ですね。
今回はそんなお悩みを解決する、
Word VBAを使い、穴埋め問題を一瞬で作る方法
についてまとめます。
もくじ
Word VBAで穴埋め問題を作成するイメージ
前回の【Word VBA】一括置換と同時に書式変更や蛍光ペンをひく方法!色やサイズ変更も!で書式変更したところを解答欄の書式へ変更させる内容となります。
問題としたい文章が記載されたWordドキュメントを用意します。
サンプルは憲法の前文です。
問題候補の単語と解答欄の記号が記載されているCSVファイルを用意します。
サンプルは実際の試験問題の解答からリストアップしてみました。
CSVファイルを設定したVBAをWordへ実装しVBAを実行すると、
CSVファイルに記載した単語の箇所が解答欄へ変更されます。
さらに文字色も変えることができ、
強調のため文字サイズも大きくできます。
穴あけ問題がワンクリックでできてしまうので試験対策に最適ですね。
それでは、早速使ってみましょう。
サンプルのWordドキュメント、置換対象リストを準備する
まずはサンプルでWordドキュメント、置換対象リストを準備しましょう。
Wordドキュメントを準備する
サンプルは憲法の前文になります。
公務員試験などでよく使われるところですね。
できたら、任意の場所へ保存します。
覚えたい単語が記載されているCSVファイルを用意する
文章中にある覚えたい単語をリスト化し、文字コードをShift-JISにしたCSV形式で保存します。
二列目には試験問題の解答欄を示す記号を入れましょう。
その場合、VBAを実行すると、「実行時エラー 5843 メソッドまたはプロパティに与えられた数値が有効範囲を超えています。」と表示されますので、
Shift-JISに変更するようお願いします。
穴埋め問題を作成するVBA
VBAを実装する
続いてWordのVisual Basic EditorへVBAを実装しましょう。
今回のVBAは前回の置換処理をベースに囲み罫線となるよう書式を変更しています。
実装にあたり、変更頂きたい箇所は以下です。
・置換リストファイルを指定する
置換リストを格納したパスに書き換えをお願いします。
VBAソースコードは以下の通りです。
Sub 複数の文字列を解答欄へ変更_穴埋め問題向け()
Dim csvFilePass
Dim strBuf As String
Dim tmp As Variant
'置換リストファイルを指定します。
csvFilePass = "C:\Users\****\Documents\****\憲法用語と解答欄一覧.csv"
Open csvFilePass For Input As #1
'CSV内の行数分置換処理を繰り返します。
Do Until EOF(1)
'1行分のデータを読み込みます。
Line Input #1, strBuf
'文字列を","で分割します。
tmp = Split(strBuf, ",")
'検索・置換の設定をおこないます。
With Selection.Find
.Format = True 'フォーマット変更を有効する(True)、有効にしない(False)を設定します。
.ClearFormatting '検索条件から書式を削除します。
.Replacement.ClearFormatting '置換対象の書式を削除します。
.Replacement.Font.Bold = True '置換対象の書式を太字にします。
.Replacement.Font.Size = 18 '置換対象の文字サイズを変更します。
.Text = tmp(0) '検索ワードを代入します。
.Replacement.Text = " " & tmp(1) & " " '置換ワードを代入します。
.Forward = True '文書に対して末尾の方向(順方向)に検索します。
.Wrap = wdFindContinue '先頭(または末尾)に戻って検索をします。
.MatchCase = True '英語の大文字と小文字の区別する(True)、区別しない(False)を設定します。
.MatchWholeWord = False '単語全体を検索対象としない設定にします。
.MatchByte = False '半角と全角を区別する(True)、区別しない(False)を設定します。
.MatchAllWordForms = False '英単語の異なる活用形検索を有効する(True)、有効にしない(False)を設定します。
.MatchWildcards = False 'ワイルドカード(?*など任意の文字)を使った検索を有効する(True)、有効にしない(False)を設定します。
.MatchSoundsLike = False '誤った置換を防止するため、英語のあいまいな検索はOFFにします。
.MatchFuzzy = False '誤った置換を防止するため、日本語のあいまいな検索はOFFにします。
End With
Selection.Find.Execute
'囲い罫線を追加します。
With Selection.Font.Borders(1)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth100pt
.Color = Options.DefaultBorderColor
End With
'置換を1件づつ実行します。
With Selection
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseStart
Else
.Collapse Direction:=wdCollapseEnd
End If
.Find.Execute Replace:=wdReplaceOne
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseEnd
Else
.Collapse Direction:=wdCollapseStart
End If
.Find.Execute
End With
Loop
Close #1
MsgBox "解答欄への変更が完了しました。"
End Sub
VBAを実装する
実装手順は以下の通りです。
①Wordを新規に開き、「開発」タブをクリックし、
「VisualBasic」をクリックします。
もしくはショートカットキー「Alt」+「F11」でもOKです。
②標準モジュールを追加します。
左ペインの「Nomal」を右クリックし、「挿入」、「標準モジュール」を選択します。
③右ペインのウインドウに上記のVBAを入力します。
こちらで完了です。
VBAを実行する
早速VBAの実行をしてみましょう。
①「開発」タブの「マクロ」をクリックし「複数の文字列を解答欄へ変更_穴埋め問題向け」を選択し、「実行」をクリックします。
②「解答欄への変更が完了しました。」が表示されたら、
置換されていることを確認します。
変更前
変更後
はい!
単語リストの箇所が解答欄へ変更されていますね!
VBAの説明
置換処理の説明についてはこちらの記事の説明をご参照ください。
今回追加した箇所は、囲い罫線を追加する処理となります。
‘囲い罫線を追加します。
With Selection.Font.Borders(1)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth100pt
.Color = Options.DefaultBorderColor
End With
罫線の書式部分を選択します。引数の1は固定です。
罫線のスタイルを指定します。wdLineStyleSingleはシンプルなラインを意味します。
罫線の幅を指定します。
罫線の色を指定します。DefaultBorderColorはデフォルトの色を意味します。
一括で置換をすると、罫線の書式がうまく適用できない箇所が生じるので、
置換は1件づつ実行するようにしています。
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseStart
Else
.Collapse Direction:=wdCollapseEnd
End If
.Find.Execute Replace:=wdReplaceOne
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseEnd
Else
.Collapse Direction:=wdCollapseStart
End If
.Find.Execute
End With
穴埋め問題を作成するVBAに解答欄の色を緑色に変更する処理を追加
次に解答欄が緑色になるよう書式を追加してみます。
実装にあたり、変更頂きたい箇所は以下です。
こちらの「’」を外し有効化します。
解答欄の記号の文字色も緑色に変更します。
.Color = Options.DefaultBorderColorと差し替えましょう。
VBAは以下の通りです。
Sub 複数の文字列を解答欄へ変更_穴埋め問題向け()
Dim csvFilePass
Dim strBuf As String
Dim tmp As Variant
'置換リストファイルを指定します。
csvFilePass = "C:\Users\****\Documents\****\憲法用語と解答欄一覧.csv"
Open csvFilePass For Input As #1
'CSV内の行数分置換処理を繰り返します。
Do Until EOF(1)
'1行分のデータを読み込みます。
Line Input #1, strBuf
'文字列を","で分割します。
tmp = Split(strBuf, ",")
'検索・置換の設定をおこないます。
With Selection.Find
.Format = True 'フォーマット変更を有効する(True)、有効にしない(False)を設定します。
.ClearFormatting '検索条件から書式を削除します。
.Replacement.ClearFormatting '置換対象の書式を削除します。
.Replacement.Font.Bold = True '置換対象の書式を太字にします。
.Replacement.Font.Size = 18 '置換対象の文字サイズを変更します。
.Replacement.Font.Color = wdColorGreen '置換対象の文字色を変更します。(薄い緑)
.Text = tmp(0) '検索ワードを代入します。
.Replacement.Text = " " & tmp(1) & " " '置換ワードを代入します。
.Forward = True '文書に対して末尾の方向(順方向)に検索します。
.Wrap = wdFindContinue '先頭(または末尾)に戻って検索をします。
.MatchCase = True '英語の大文字と小文字の区別する(True)、区別しない(False)を設定します。
.MatchWholeWord = False '単語全体を検索対象としない設定にします。
.MatchByte = False '半角と全角を区別する(True)、区別しない(False)を設定します。
.MatchAllWordForms = False '英単語の異なる活用形検索を有効する(True)、有効にしない(False)を設定します。
.MatchWildcards = False 'ワイルドカード(?*など任意の文字)を使った検索を有効する(True)、有効にしない(False)を設定します。
.MatchSoundsLike = False '誤った置換を防止するため、英語のあいまいな検索はOFFにします。
.MatchFuzzy = False '誤った置換を防止するため、日本語のあいまいな検索はOFFにします。
End With
Selection.Find.Execute
'囲い罫線を追加します。
With Selection.Font.Borders(1)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth100pt
.Color = wdColorGreen
End With
'置換を1件づつ実行します。
With Selection
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseStart
Else
.Collapse Direction:=wdCollapseEnd
End If
.Find.Execute Replace:=wdReplaceOne
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseEnd
Else
.Collapse Direction:=wdCollapseStart
End If
.Find.Execute
End With
Loop
Close #1
MsgBox "解答欄への変更が完了しました。"
End Sub
実行してみましょう。
はい、置換対象の罫線と文字が緑色になりましたね!
置換対象文字色の変更に加え、文字サイズを変更するVBA
文字色置換処理と同時に文字サイズを変更する処理を加えてみましょう。
変更頂きたいコードは以下です。
前回の文字サイズ18ポイントから25ポイントへ増やしています。
実行をすると、
はい、文字サイズが大きくなりましたね!
さいごに
いかがでしょうか。
今回は、
Word VBAを使い、穴埋め問題を一瞬で作る方法
についてまとめました。
今回のVBAと置換リストをうまく活用すれば、短時間で処理ができるので、ぜひ活用いただければと思います。
遅くなりましたが、うまくできましたありがとうございます。
できたようでよかったです!
上記内容を参考にVBAに挑戦しているのですが、このまま使用すると
実行時エラーで枠線の太さのところで実行時エラー5843出て
メソッドまたはプロパティに与えられた数値が有効範囲を超えていますとなります
この部分はエラー行をコメントアウトすることで直面実行することができるのですが
このエラー調べましても修正方法がわからなかったのでよろければ教えていただけるとありがたいです、また上記コメントアウトして実行すると四角囲みで穴埋め問題ができるのですが四角囲みごとに改行されて非常に大変な事になります。
この部分は色々と調べたのですが修正することができず困っています。
併せてご回答いただけるとありがたいです。
いつもご利用ありがとうございます。
実行時エラー5843となる件につきまして、こちらでも事象の再現ができました。
読み込んでいるCSVファイルの文字コードをShift JIS以外に指定した場合にエラーとなる場合があります。
CSVファイルを秀丸などテキストエディタで開き文字コードをShift JISに指定いただきたくお願いいたします。
※メモ帳ではUTF8が標準文字コードとなりますので、ご注意ください。
改行がされてしまう件については要因はわかりかねますが、上記対応で併せて改善されるかご確認をお願い致します。