文書内に挿入した画像に枠を付ける（Word）
文書内に挿入した画像に枠を付ける
Wordの文書内に挿入した画像に枠囲いを付けるのは、結構めんどくさいので、枠で囲うマクロを作った。
こんなことができます
Wordの文書内に挿入した画像に、ワンクリックで囲みを付ける。ただ、それだけ。
目次
画像に枠囲みを施すのはめんどくさい
Wordで文書中に画像を挿入し、枠囲みを施すのは実にめんどくさい。
このことをまず示す。
画像の挿入
まず、「挿入」タブをクリックする。
次は、「画像」をクリック。
画像ファイルのある場所をクリックする。
ファイルを選び、［挿入］をクリック。
やっと画像が挿入された。デカっ！
テキトーなサイズに調整しよう。不愉快きわまりない画像なので小さくしてやれ。
たかが画像を挿入するだけで、こんなに手間がかかるのである。（ちなみに、このとき「段落」設定で「行間」を「固定値」にしていると、ちょっとビックリするような状態になる。）
画像に枠線を施す
次は、牛だ。
いや、違った。枠線だ。
挿入した画像を右クリックし、コンテキストメニューの「図の書式設定」をクリック。
「塗りつぶしと線」アイコンをクリック。
線の種類とか色をテキトーに設定。
画像に枠線が施された。
どうだろう。めちゃくちゃめんどくさくないか？
こういうときのための、マクロですよ！
画像に枠囲みを施すマクロ
まずはコードをお目にかけよう。
リスト１ 標準モジュール
Public Sub SetBordersForFigureMain() '……(1)'
Call setBordersForFigure
End Sub
Private Sub setBordersForFigure( _
Optional ByVal LineStyle As WdLineStyle _
= wdLineStyleSingle, _
Optional ByVal LineWidth As WdLineWidth _
= wdLineWidth100pt) '……(2)'
Dim ilShp As InlineShape
If Selection.Type = wdSelectionInlineShape Then '……(3)'
If Selection.InlineShapes.Count = 0 Then Exit Sub '……(4)'
Set ilShp = Selection.InlineShapes(1)
Else
Exit Sub
End If
With ilShp.Borders '……(5)'
.OutsideLineStyle = LineStyle
.OutsideLineWidth = LineWidth
End With
End Sub
(1)の
Public Sub SetBordersForFigureMain() Call setBordersForFigure End Sub
は、下のsetBordersForFigureメソッドを呼び出しているだけ。メインの処理はそっちに書いてある。
で、setBordersForFigureメソッド。
(2)の
Private Sub setBordersForFigure( _
Optional ByVal LineStyle As WdLineStyle _
= wdLineStyleSingle, _
Optional ByVal LineWidth As WdLineWidth _
= wdLineWidth100pt)
で引数の設定。
LineStyleは線の種類で、LineWidthは線の太さ。
両方ともOptionalにして、デフォルト値は一番よく使うっぽいやつにしてある。
(3)の
If Selection.Type = wdSelectionInlineShape Then If Selection.InlineShapes.Count = 0 Then Exit Sub '……(4)' Set ilShp = Selection.InlineShapes(1) Else Exit Sub End If
は、選択範囲のチェック。
Selectionオブジェクトの状態を確認して、実行するかどうかを判定。
今回は、〝選択している画像に枠線を施す〟というマクロにする。
Selection.Typeの値がwdSelectionInlineShapeだったら、挿入された画像だという判定にする。
ところが、困ったことに、選択中のオブジェクトが行内に挿入した〝図形〟であっても「Selection.Type = wdSelectionInlineShape」がTrueになってしまう。
で、そのときには、なぜかInlineShapesのCountプロパティが0なので、
Set ilShp = Selection.InlineShapes(1)
で実行時エラーになってしまう。
わけがわからないが、仕方がないので(4)の
If Selection.InlineShapes.Count = 0 Then Exit Sub
で、Selection.InlineShapes.Countが0のときは何もせずに抜けることにした。うーむ、わけわからん。
ともかく、ここまで来ると、
Set ilShp = Selection.InlineShapes(1)
により、変数ilShpには選択中の画像がぶち込まれているので、あとは(5)の
With ilShp.Borders .OutsideLineStyle = LineStyle .OutsideLineWidth = LineWidth End With
で線の種類と線の太さを設定しておしまい。
使ってみる
クイック アクセス ツール バーにマクロを登録して使ってみる。
Yes！ 超便利、なう。
おわりに
逆に、画像に施した枠線を除去するマクロの書き方がわからない。
誰か知っている人がいたら教えろ教えてください。
追記
枠線を消すマクロ、できました。
関連記事
ブック内で使用している関数の数をカウントするマクロ（Excel）
ブック内で使用している関数の数をカウントするマクロ（Excel）
久しぶりのExcelネタだ。
とりあえずコードをぶちまける
現在（？）、Excelには、488個の関数があるらしい。
その488の関数名をコピッペしたこんなシートを用意して、
その関数名リストの部分に「FUNCTIONS_LIST」と名前を付けた。
これだけ準備をしておいて、このシートのモジュール（「Sh01Main」と名付けてある。）に、次のコードを書いた。
先に言っておく。長いぜ。
リスト１ シートモジュールSh01Main
Option Explicit Private Const FUNCTIONS_LIST As String = "FUNCTIONS_LIST" Private m_FunctionsArr As Variant '関数名リスト用' Private m_CountArr() As Long '関数使用数格納用' Private m_FormulaArr As Variant '各セルの数式格納用' Private m_OpeArr() As String '関数名のアタマの記号格納用' Private m_CountArea As Range '使用数書き込み先セル格納用' Private Sub countFunctionsEntry(ByVal TgtBook As Workbook) '処理に使う変数等の準備' '関数名のアタマに付く可能性のある記号たち（網羅できている？）' Const PRE_OPERATORS As String = "= ( + - * / & < > ^ ," m_OpeArr = Split(PRE_OPERATORS) m_FunctionsArr = Me.Range(FUNCTIONS_LIST).Value ReDim m_CountArr(1 To UBound(m_FunctionsArr, 1) + 1, 1 To 1) Set m_CountArea = Me.Range(FUNCTIONS_LIST).Offset(0, 1) Call m_CountArea.ClearContents 'ブック内のワークシートごとにメソッド呼び出し' Dim tgtSh As Worksheet For Each tgtSh In TgtBook.Worksheets Call countSheetsFunctions(tgtSh) Next '最後に関数の使用数を書き込む' m_CountArea.Value = m_CountArr End Sub Private Sub countSheetsFunctions(ByVal TgtSheet As Worksheet) '///シート内各セルの数式を取得' 'UsedRangeがなかったら処理しなくて良い' If TgtSheet.UsedRange.Count = 0 Then Exit Sub 'UsedRangeが1セルだったら、別途2次元配列化する' If TgtSheet.UsedRange.Count = 1 Then ReDim m_FormulaArr(1, 1) m_FormulaArr(1, 1) = TgtSheet.UsedRange.Cells(1, 1).Formula '2セル以上あるときは、直接2次元配列化' Else m_FormulaArr = TgtSheet.UsedRange.Formula End If '数式がある限り、一つ一つ調べる' Dim i As Long Dim j As Long For i = LBound(m_FormulaArr, 1) To UBound(m_FormulaArr, 1) For j = LBound(m_FormulaArr, 2) To UBound(m_FormulaArr, 2) If m_FormulaArr(i, j) = "" Then GoTo Continue Call countFunctions(m_FormulaArr(i, j)) Continue: Next Next End Sub Private Sub countFunctions(ByVal TgtFormula As String) '///関数名ごとに数式内に含まれているかどうか調べる' If Left(TgtFormula, 1) <> "=" Then Exit Sub Dim i As Long Dim funcName As String Dim n As Long Dim result As Long For i = LBound(m_FunctionsArr, 1) To UBound(m_FunctionsArr, 1) funcName = m_FunctionsArr(i, 1) '「関数名 + (」が含まれていなければ調べなくて良い' If InStr(1, TgtFormula, funcName & "(") = 0 Then GoTo Continue Call detectFunction(TgtFormula:=TgtFormula, _ TgtFuncName:=funcName, _ TgtIndex:=i) Continue: Next End Sub Private Sub detectFunction(ByVal TgtFormula As String, _ ByVal TgtFuncName As String, _ ByVal TgtIndex As Long) '///「先頭記号 + 関数名 + (」が見つかるごとにカウントアップ' Dim n As Long Dim result As Long Dim i As Long For i = LBound(m_OpeArr) To UBound(m_OpeArr) n = 1 Do result = InStr(n, TgtFormula, m_OpeArr(i) & TgtFuncName & "(") If result > 0 Then '見つかったら関数使用数格納用配列の当該要素をカウントアップ' m_CountArr(TgtIndex, 1) = m_CountArr(TgtIndex, 1) + 1 n = result + Len(TgtFuncName) + 2 '次の検索開始位置（result + (関数名の長さ + 2)） の値から、' '残りの文字数を調べる。 ' '「2」は、関数名の前の文字と関数名の後ろの「(」の字数 ' '残りの文字数が、関数名 + 2 （検索対象文字列の文字数）より ' 'も少なかったら検索終了。' If Len(TgtFormula) - n + 1 < Len(TgtFuncName) + 2 Then Exit Do Else Exit Do End If Loop Next End Sub Private Sub entryPoint() '///エントリポイント' ' 同一フォルダ内の test.xlsm にある関数名をカウントする' Dim tgtBk As Workbook Set tgtBk = Application.Workbooks.Open( _ ThisWorkbook.Path & "\" & "test.xlsm") '" Call countFunctionsEntry(tgtBk) Call tgtBk.Close(False) End Sub
ふう。長いなあ……。
とりあえずコードを晒したかっただけなので、説明は省略。
使ってみる
同じフォルダ内に、「test.xlsm」というファイル名の数式入りExcelブックを置いておいて、上記リスト１のentryPoint（一番下のプロシージャ）を実行すると……。
こうなる。メチャクチャ力技な処理の割には、結構速い。
使用回数順に並べ替えると、
実にわかりやすい。
おわりに
ただし、一定の条件を満たしていれば、数式として機能していない文字列をカウントしてしまうので、正確な数値が出るとは限らないこと、お断りしておきます。
関数のアタマにくっつく可能性のある記号類は、網羅できているんですかね？
割り当てたショートカットキーを忘れないようにする
割り当てたショートカットキーを忘れないようにする
これはタイトルに偽りありかも知れない。
よく使うマクロを使いやすくする
クイック アクセス ツール バーを使う
たとえば、前回
紹介した〝選択箇所に傍点を施すマクロ〟のような、〝ちょっと便利なマクロ〟は、サクッと気軽に使いたい。
そのための一つの方法が
クイック アクセス ツール バーに登録する
というものだろう。
これはかつて書いたことがあるので、
コチラをどうぞ。
これで、ワンクリックで機能を呼び出すことができる。
便利！
ショートカットキーを割り当てる
しかし、いちいちクイック アクセス ツール バーをクリックしに行くのがめんどくさい、ということもあるかもしれない。
そんなときは、ショートカットキーを割り当てたらよい。
やり方は、
コチラをどうぞ。
これはこれで実に快適。
ショートカットキー割り当ての問題点
しかし、困ったことが一つ。
どのショートカットキーを割り当てたか、忘れるのである。
これは困った。
〝ショートカットキーを忘れる〟問題への対応
そこで、ナイスなアイディアを思いついた。
忘れるなら、思い出させれば良いのである。
名付けて、
マリー・アントワネット作戦
である！
リスト１
Public Sub AddEmphasisMain()
Static hasShown As Boolean
Call AddEmphasisMark
If Not hasShown Then
Debug.Print "ショートカット キーは、[Ctrl]+[Alt]+[@]や。"
hasShown = True
End If
End Sub
Public Sub AddEmphasisMark( _
Optional ByVal EmphasisMarkType As WdEmphasisMark = wdEmphasisMarkOverComma)
Dim rng As Range
Set rng = Selection.Range
rng.EmphasisMark = EmphasisMarkType
End Sub
ショートカットキーを忘れたら、一度クイック アクセス ツール バーから実行し、イミディエイトを見れば良いのである！
そして、Static変数でイミディエイトへの出力の有無を切り替えているので、以後実行するごとにイミディエイトにメッセージがたまっていく、ということもない。
おわりに
まさに、天才的アイディアである！
（「羊頭狗肉」だと？！ うるせえ、黙ってろ！）
傍点マクロをNormal.dotmに書く（Word）
傍点マクロをNormal.dotmに書く
傍点マクロをNormal.dotmに書く
前回
作成した傍点マクロ。私は文書作成時にやたらと傍点を使う（というよりは、私の尊敬する書き手が皆一様によく傍点を使うため、引用するときにやたら傍点を施す必要が生ずる）ので、傍点が気軽に打てるのは助かる。
そこで、傍点マクロをいろいろなドキュメントで使い回せるように、標準テンプレートであるNormal.dotmに置くことにする。
Normal.dotmに標準モジュールを置く
まず、プロジェクト エクスプローラー上で、「Normal」のところの「＋」をクリックする。
次に、「Microsoft Word Object」のところの「＋」をクリックする。
「ThisDocument」のあたりで右クリックし、コンテキストメニューを「挿入」→「標準モジュール」の順にクリックする。
これで、めでたく標準モジュール「Module1」が生まれた。
モジュール名が気にくわなければ、プロパティウィンドウの「オブジェクト名」のところ
で名前を変更してやれば良い。
画像では「UsefulMacros」としている。
設置した標準モジュールにコードを書く
前回記事のリスト１とリスト２を先ほど挿入した標準モジュールに書く。
リスト１（再掲）
Private Sub addEmphasisMark( _
Optional ByVal EmphasisMarkType As WdEmphasisMark = _
wdEmphasisMarkOverComma)
Dim rng As Range
Set rng = Selection.Range
rng.EmphasisMark = EmphasisMarkType
End Sub
リスト２（再掲）
Public Sub AddEmphasisMarkMain() Call addEmphasisMark End Sub
とりあえずこんだけ。
終わりに
これで、このマクロを仕込んだ端末で編集するたいていのWordドキュメントで傍点マクロを使用することが可能になる。（ですよね？）
【追記】
Normal.dotmは、Word文書編集中、その影で常駐しているっぽい（他のテンプレートから新規作成したときでも、プロジェクト エクスプローラーに標示されている。）ので、Normal.dotmに仕込んだマクロは、その端末で編集する全てのドキュメントから利用可能なはずです。
関連記事
選択箇所に傍点を施す（Word）
選択箇所に傍点を施す
選択箇所に傍点を施すマクロ
選択箇所に傍点を施すのはめんどくさい
選択箇所に傍点を施すのは実にめんどくさい。
仮に、リボンのタブが「ホーム」にある状態からでも、
対象範囲を選択し、
「フォント」グループの「ダイアログボックスランチャー」（みんな、こんな名前だって知ってた？）をクリックし、
「傍点」のところのドロップダウンをクリックし、
任意の傍点の種類をクリックし、
［OK］をクリックする
と、範囲を選択してからでも、実に4回ものクリックを重ねなければたどり着けない苦難の道のりなのである。
これはめんどくさい。
そう思ったら、マクロですよ！
選択箇所に傍点を施すマクロ
これは実に簡単。
傍点を施したい箇所のRangeオブジェクトを取得し、そのRangeオブジェクトのEmphasisMarkプロパティに望みの値を設定してやればよい。
EmphasisMarkプロパティの値の設定には、WdEmphasisMark列挙体の使用が可能。列挙体の各要素は次の通り。
wdEmphasisMarkNonewdEmphasisMarkOverCommawdEmphasisMarkOverSolidCirclewdEmphasisMarkOverWhiteCirclewdEmphasisMarkUnderSolidCircle
まあ、名前を見たらだいたいどんなのか想像つくと思う。
日本語の文章で使うのはほぼ「wdEmphasisMarkOverComma」でしょう。
コードは次のような実に簡単なものになる。
リスト１
Private Sub addEmphasisMark( _
Optional ByVal EmphasisMarkType As WdEmphasisMark = _
wdEmphasisMarkOverComma)
Dim rng As Range
Set rng = Selection.Range
rng.EmphasisMark = EmphasisMarkType
End Sub
引数としてWdEmphasisMark列挙体を受け取って、その傍点を選択範囲に施す、というだけのもの。
先にも述べたとおり、日本語の文書では通常「、」の形の傍点を使うので、Optionalにした上でデフォルト値をwdEmphasisMarkOverCommaにしている。
使ってみる
次のコードで実行。
リスト２
Public Sub AddEmphasisMarkMain() Call addEmphasisMark End Sub
これで良い。
対象の箇所を選択して、リスト２を実行する。
ほれ、バッチリ。
おわりに
なんで今までこういうことをしてこなかったのだろう。
関連記事
段落単位で置換できる（Word）
段落単位で置換できる
Wordで、特定の範囲だけ置換したかった。
目次
標準機能による置換
普通、置換はこうする。
画像中に示した、「《 》」でくくられた箇所を置換したいとき、[Ctrl] + [ H ]で置換ダイアログを呼び出して、
このようにすればよい。
しかし、これだと当たり前のことながら、文書全体の当該箇所が根こそぎ置換されてしまう。
もちろん、必要な範囲のみ選択した状態で実行すれば良いが、それは単に〝手動〟なのであって、あまり有効な解決策とは言えない。
Find.Executeメソッドによる置換
たとえば、次のリスト１を実行するとどうか。
リスト１ 標準モジュール
Private Sub test01()
Call Selection.Find.Execute(FindText:="《*》", _
ReplaceWith:="", _
Replace:=wdReplaceAll, _
MatchWildcards:=True)
End Sub
こいつを実行するとどうなるか。
カーソルのある場所以降の部分のみ置換されるのである。
これは実に便利な仕様。
しかし、これは〝どこから〟しか指定できないことを意味する。
段落単位でFind.Executeメソッドを使う
Wordでは、段落単位で文書の断片を取得することができる。
[Document].Paragraphsコレクションのインデックスを指定すれば良いのである。
たとえば、18番目～21番目の段落の部分のみ置換を実行したければ、次のようなコードを書けば良い。
リスト２ 標準モジュール
Private Sub test02()
Dim Doc As Document
Set Doc = ActiveDocument
Dim i As Long
For i = 18 To 21
With Doc.Paragraphs(i)
Call .Range.Find.Execute( _
FindText:="《*》", _
ReplaceWith:="", _
Replace:=wdReplaceAll, _
MatchWildcards:=True)
End With
Next
End Sub
見ての通り、18～21の各段落に順に[Range].Find.Executeメソッドを実行して置換している。
結果はこの通り。
見事に狙った箇所のみ置換することに成功している。
おわりに
これで、置換を施したい対象箇所の始めと終わりに、当該文書内では出てこないような文字列（「＠＠＠」とか。）を目印として置いておき、その段落を取得するようにすれば、文書内の狙った範囲の箇所にのみ置換を実行することができる。
段落番号を取得するやつは、
このときに作成済み。
Wordの表の中の文字列
Wordの表の中の文字列
けったいな現象が起こったので報告。
表の中の文字列
Wordドキュメント上に、次のような表を作成する。
で、次のコードで表の左上端セルの文字列を取り出してみる。
リスト１ 標準モジュール
Private Sub test() Dim tbl As Table Set tbl = ActiveDocument.Tables(1) Dim rng As Range Set rng = tbl.Cell(1, 1).Range '……(1)' Debug.Print rng.Text '……(2)' Debug.Print Len(rng.Text) End Sub
(1)の
Set rng = tbl.Cell(1, 1).Range
で、表の中の左上端セルを指し示すRangeオブジェクトを変数rngに突っ込み、(2)からの2行
Debug.Print rng.Text Debug.Print Len(rng.Text)
でそのRangeオブジェクトが持っている文字列を出力するとともに、その文字列の文字数を出力する。
コイツを実行してやると、
となる。
セルの中の文字列は「アホ」と改段落マークなので、文字数は3と思いきや、4である。
イミディエイトの結果を見ても、「アホ」の他に、改段落と何かわけのわからんものが付着しているのが何となく分かる。
ケツに付着している文字は何か
このケツに付着している文字が何なのかを調べる。
今度は、次のコードでやってみる。
リスト２ 標準モジュール
Private Sub test08() Dim tbl As Table Set tbl = ActiveDocument.Tables(1) Dim rng As Range Set rng = tbl.Cell(1, 1).Range Debug.Print rng.Text Debug.Print Len(rng.Text) Debug.Print Asc(Right(rng.Text, 1)) '……(3)' End Sub
先のリスト１に(3)の
Debug.Print Asc(Right(rng.Text, 1))
を付け加えただけ。
rng.Textの一番ケツの文字の文字コード番号を出力する。
こいつを実行すると、
こうなる。
ケツにひっついているのは、文字コード「7」のやつ、つまり、Chr(7)なのである。
Chr(7)とは？
コチラのサイトによると、Chr(7)とは、
BELというやつである。
なんじゃそら。〔※〕
とにかく、Wordの表のセル内の文字列のケツには、「ベル文字」というやつがひっついているらしい。
ベル文字を除去するとどうなるか
では、この「ベル文字」とやらを除去するとどうなるのか。
次のコードで実験。
リスト３ 標準モジュール
Private Sub test08() Dim tbl As Table Set tbl = ActiveDocument.Tables(1) Dim rng As Range Set rng = tbl.Cell(1, 1).Range rng.Text = Replace(rng.Text, Chr(7), "") '……(4)' End Sub
(4)の
rng.Text = Replace(rng.Text, Chr(7), "")
で、Replace関数を用いて「ベル文字」を除去した文字列をrng.Textにセットしてやるのだ。
ふふふ。「ベル文字」とやら、消え失せい!!!!!!!!
！
わけわからん……。
セル内の文字列はどうなっとるのか
次のコードで調べてみた。
リスト４ 標準モジュール
Private Sub test09()
Dim tbl As Table
Set tbl = ActiveDocument.Tables(1)
Dim rng As Range
Set rng = tbl.Cell(1, 1).Range
Dim tmp As String
tmp = rng.Text
Dim i As Long
For i = 1 To Len(tmp)
Debug.Print Asc(Mid(tmp, i, 1))
Next
End Sub
セル内の文字列を1文字づつ切り出して、Asc関数でコード番号を出力してみる。
なんと、Chr(7)をポアしたはずなのに、復活しているどころか「Chr(13) & Chr(7)」に置き換わってしまっておるではないか……。
おわりに
謎は深まるばかりである……。
