画像に枠線を施すマクロの書き換え（Word）
画像に枠線を施すマクロの書き換え
前回
枠線を消すマクロで、[InlineShape].Lineプロパティ（＝LineFormatオブジェクト）を用いたので、枠線を施す方も[InlineShape].Lineプロパティを用いる方法に書き換える。
このときのリスト１を書き換えるということ。
書き換えたコード
リスト１
Public Sub SetBordersForFigureMain()
Call setBordersForFigure
End Sub
Private Sub setBordersForFigure( _
Optional ByVal LineStyle As MsoLineStyle = msoLineSingle, _
Optional ByVal LineWeight As Single = 1#)
Dim ilShp As InlineShape
If Selection.Type = wdSelectionInlineShape Then
If Selection.InlineShapes.Count = 0 Then Exit Sub
Set ilShp = Selection.InlineShapes(1)
Else
Exit Sub
End If
Dim tgtLnFormat As LineFormat '……(1)'
Set tgtLnFormat = ilShp.Line
With tgtLnFormat '……(2)'
.Visible = msoTrue
.Style = LineStyle
.Weight = LineWeight
End With
End Sub
(1)からの7行
Dim tgtLnFormat As LineFormat Set tgtLnFormat = ilShp.Line With tgtLnFormat '……(2)' .Visible = msoTrue .Style = LineStyle .Weight = LineWeight End With
は、別に
With ilShp.Line '……(2)' .Visible = msoTrue .Style = LineStyle .Weight = LineWeight End With
と書いてもかまわない。
しかしながら、「LineFormatオブジェクトを操作しておるのだ！」という感じを出すために、あえてこうしている。大阪府の吉村知事が、〝やってる感〟を出すために「いつ仕事してんのかわからんぐらいテレビに出まくって」いるのと同じである。
(2)の
With ilShp.Line .Visible = msoTrue .Style = LineStyle .Weight = LineWeight End With
では、取得したLineFormatオブジェクトのうち、Visible、Style、Weightの三つのプロパティのみ設定。
これらは、それぞれ
こいつらに対応している（と思う。）。
使ってみる
バッチリ。
おわりに
これで、枠線を施すマクロと枠線を削除するマクロが、きっちり対応しました。
画像の囲み線を消すマクロ（Word）
画像の囲み線を消すマクロ（Word）
前回
の最後のところで、
逆に、画像に施した枠線を除去するマクロの書き方がわからない。
誰か知っている人がいたら教えろ教えてください。
などと言っていたが、とりあえずやり方はわかった。
画像の枠線を消すマクロ
InlineShapeオブジェクトのLineプロパティ
InlineShapeオブジェクトには、Lineプロパティというものがあるらしい。
『Word 2013 developer docs』（Word2013のオフライン・ヘルプ）によると、
InlineShape.Line Property (Word)
Returns a LineFormat object that contains line formatting properties for the specified shape. Read-only.
Syntax
expression .Line
expression A variable that represents an InlineShape object.
ということらしい。
Lineプロパティという名前だが、Lineオブジェクトを返すわけではなく、あくまでもLineFormatオブジェクトを返す、ということ。
……となると、LineFormatオブジェクトについても調べておかざるを得ない。
LineFormatオブジェクトとは
これまた、『Word 2013 developer docs』によると、
LineFormat Object (Word)
Represents line and arrowhead formatting. For a line, the LineFormat object contains formatting information for the line itself; for a shape with a border, this object contains formatting information for the shape's border.
とのこと。
「a shape with a border」というのは、まさにドキュメント内に挿入した画像のことなので、こいつに含まれている「formatting information for the shape's border」をいじくってやれば、囲み線を消すことができるはずだ。
ちなみに、LineFormatオブジェクトのメンバは、
この通り。めっちゃ多い。
境界線を消すには
境界線を消すためには、LineFormatオブジェクトのVisibleプロパティをどうにかしたらよさげ。
みたび『Word 2013 developer docs』によると、
LineFormat.Visible Property (Word)
True if the specified object, or the formatting applied to it, is visible. Read/write MsoTriState.
とのこと。
単にTrue / Falseの二値なのではなく、MsoTriStateという列挙体で設定するらしい。
『オブジェクト ブラウザー』で調べてみると、MsoTriState列挙体のメンバは、
msoCTruemsoFalsemsoTriStateMixedmsoTriStateTogglemsoTrue
となっている。
なんで、「Tri」なのに五つもの状態が決められているのかよくわからん（三つじゃねえのかよ。）し、「CTrue」っていうのもなんのことかようわからん。
それでも、VisibleプロパティをmsoFalseにしたら、囲み線を非表示にすることはできそうだ。
画像の囲み線を消すマクロのコード
……というわけで、コードをば。
リスト１
Public Sub RemoveBordersOfFigure()
Dim ilShp As InlineShape
If Selection.Type = wdSelectionInlineShape Then
Set ilShp = Selection.InlineShapes(1)
Else
Exit Sub
End If
ilShp.Line.Visible = msoFalse
End Sub
ふむ。まっ たく 簡 単 だ。
使ってみる
この状態で、画像を選択して、リスト１を実行する。
ちなみに、「図の書式設定」は、
この状態。
ほれ、この通り。囲み線が消えている。
「図の書式設定」も
万全。バッチリ。
おわりに
これで、画像入りのWordドキュメントの作成がはかどることでしょう。
めでたしめでたし。
印刷マクロでちょっとハマる（Word）
印刷マクロでちょっとハマる（Word）
フォルダ内にたくさんあるWordドキュメントの先頭ページだけを印刷する必要があって（どんな「必要」やねん。）、
ちょろっとマクロ書いて片付けるか！
と意気込んで始めたにもかかわらず、ちょっとハマったので、報告。
先頭ページだけを印刷するマクロ
先頭ページだけを印刷するには、[Document].PrintOutメソッドを用いたら楽勝だと思った。
リスト１
Private Sub test08() Dim tgtDoc As Document Set tgtDoc = ActiveDocument Call tgtDoc.PrintOut(Range:=wdPrintFromTo, From:=1, To:=1) End Sub
PrintOutメソッドの引数RangeにwdPrintFromToを指定し、From、Toの両方に1を指定。
これで、ドキュメントの1ページ目から1ページ目、すなわち、先頭ページだけを印刷することができるはずだ。
実行
満を持してリスト１を実行してみる。すると、
あえなく実行時エラーになるのである。
原因は、
ここなのだが……。
おわりに
原因がわかるだろうか……？
私は公式のリファレンスを見るまで、結構な時間ハマりました……。
傍点マクロの改良（Word）
傍点マクロの改良
目次
傍点マクロのイマイチなところ
このときに紹介した傍点マクロ。
便利だと思っていたが、ショートカットキーでサクッと使えるようになると、コロナの弱点が見えてきた。大阪府の吉村知事ばりに！
こいつをご覧ください。
おわかりだろうか。傍点を施した箇所が選択されたままなのである。
しかも！
続けて文字を入力すると、このようなみじめな状態になるのである！
これはめちゃくちゃ不便である！
……ではなくって、さあ改良だ！
傍点マクロを改良する
前回のリストを参考に再掲する。
リスト１
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
AddEmphasisMarkMainからAddEmphasisMarkメソッドを呼び出す形にしている。
AddEmphasisMarkメソッドには、傍点を打つことに専念してもらい、傍点を打った後の処理は、呼び出し側のAddEmphasisMarkMainでやることにする。
変更後のコードを示す。
リスト２
Public Sub AddEmphasisMain()
Static hasShown As Boolean
Call AddEmphasisMark
If Not hasShown Then
Debug.Print "ショートカット キーは、[Ctrl]+[Alt]+[@]や。"
hasShown = True
End If
Call Selection.Collapse(wdCollapseEnd) '……(1)'
Selection.Font.EmphasisMark = wdEmphasisMarkNone '……(2)'
End Sub
Public Sub AddEmphasisMark( _
Optional ByVal EmphasisMarkType As WdEmphasisMark _
= wdEmphasisMarkOverComma)
Dim rng As Range
Set rng = Selection.Range
rng.EmphasisMark = EmphasisMarkType
End Sub
二箇所コードを追加している。
まず、(1)の
Call Selection.Collapse(wdCollapseEnd)
で選択箇所を潰し、(2)の
Selection.Font.EmphasisMark = wdEmphasisMarkNone
で現在カーソルのある箇所（傍点を施した文字列直後の位置）を傍点なしにする。
これだけ。
使ってみる
傍点を施したい箇所を選択して、ショートカットキーでマクロを起動してみる。
ふふふ。快適だ。
終わりに
こういう小さなマクロを作るのが、Wordの場合は特に面白いと思います。
関連記事
文書内に挿入した画像に枠を付ける（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変数でイミディエイトへの出力の有無を切り替えているので、以後実行するごとにイミディエイトにメッセージがたまっていく、ということもない。
おわりに
まさに、天才的アイディアである！
（「羊頭狗肉」だと？！ うるせえ、黙ってろ！）
