WMIのWin32_Printerクラス

WMIのWin32_Printerクラス

VBAでプリンタまわりを操作したいなあと思って、あれこれ調べていると、「WMI（Windows Management Instrumentation）」というものを使うという道があることがわかった。

そうしょっちゅう使うわけでもないが、覚書として記しておくことにする。

ちなみに、Shellを使う方法については、

akashi-keirin.hatenablog.com

コチラをどうぞ。

目次

• お世話になったサイト
• VBAに移植する
• 残された課題
• おわりに

お世話になったサイト

いろいろ調べているうちにたどり着いたのは、

www.wmifun.net

こちら。

このページには、次のサンプルコードが掲載されている。

Option Explicit

'WMIにて使用する各種オブジェクトを定義・生成する。'
Dim oClassSet
Dim oClass
Dim oLocator
Dim oService
Dim sMesStr

'ローカルコンピュータに接続する。'
Set oLocator = WScript.CreateObject("WbemScripting.SWbemLocator")
Set oService = oLocator.ConnectServer
'クエリー条件を WQL にて指定する。'
Set oClassSet = oService.ExecQuery("Select * From Win32_Printer")

'コレクションを解析する。'
For Each oClass In oClassSet

sMesStr = sMesStr & "プリンタの名前: " & oClass.Caption & vbCrLf & _
"プリンタのドライバー名: " & oClass.DriverName & vbCrLf & _
"プリンタのポート: " & oClass.PortName & vbCrLf & _
"デフォルトプリンタか？: " & CStr(oClass.Default) & vbCrLf & vbCrLf

Next

MsgBox "プリンタに関する情報です。" & vbCrLf & vbCrLf & sMesStr

'使用した各種オブジェクトを後片付けする。'
Set oClassSet = Nothing
Set oClass = Nothing
Set oService = Nothing
Set oLocator = Nothing

WMI Fun!! 様より

詳しいことはよくわからんが、WbemScriptingというライブラリにあるSWbemLocatorクラス（？）から順に下位のクラスを取得していっている模様。

上掲ソースコードはVBSのものだが、VBEで［ツール］→［参照設定］で、Microsoft WMI Scripting V1.2 Libraryにチェックを入れれば、オブジェクト ブラウザーである程度まで中身を見ることができる。

上掲コードの

Set oLocator = WScript.CreateObject("WbemScripting.SWbemLocator")

で変数oLocatorにぶち込まれるのは、たぶん、

このWbemScripting.SWbemLocatorクラスのインスタンス。

んで、

Set oService = oLocator.ConnectServer

こいつによって変数oServiceにぶち込まれるのは、たぶん、

このSWbemServicesオブジェクト。

さらに。

Set oClassSet = oService.ExecQuery("Select * From Win32_Printer")

で、SWbemServicesオブジェクトのExecQueryメソッドによってWin32_Printerというオブジェクトを取得し、変数oClassSetにぶち込んでいる（のだと思う）。

変数の名前からして、こいつは、

SWbemObjectSetというオブジェクトだと思う。

あとは、For ～ Eachを使ってSWbemObjectSetからSWbemObject（インストールされているプリンタ一つ一つに対応）を取り出して、そのプロパティの値を取得している（のだと思う）。

んで、このとき一つ一つ取り出されるオブジェクトは、

SWbemObjectだろう。

VBAに移植する

先に引用したコードを、VBA向けに移植する。

せっかくMicrosoft WMI Scripting V1.2 Libraryを参照設定済みなので、アーリー・バインディング方式でコーディングすることとしよう。

上掲コードではメッセージボックスに表示するようにしているが、うっとうしいので、イミディエイト・ウィンドウに出力するようにしているので、あしからず。

リスト１　標準モジュール

Private Sub test01()
  Dim currLocator As WbemScripting.SWbemLocator
  Dim tgtServices As WbemScripting.swbems
  Dim tgtClassSet As WbemScripting.SWbemObjectSet
  'ローカルコンピュータに接続する。'
  Set currLocator = New WbemScripting.SWbemLocator
  Set tgtServices = currLocator.ConnectServer
  'クエリー条件を WQL にて指定する。'
  Set tgtClassSet = tgtServices.ExecQuery("SELECT * FROM Win32_Printer")
  
  Dim tgtClass As WbemScripting.SWbemObject
  Dim tmp As String
  'コレクションを解析する。'
  For Each tgtClass In tgtClassSet
    With tgtClass
      tmp = "プリンタの名前: " & .Caption & vbCrLf & _
            "プリンタのドライバー名: " & .DriverName & vbCrLf & _
            "プリンタのポート: " & .PortName & vbCrLf & _
            "デフォルトプリンタか？: " & CStr(.Default) & vbCrLf & vbCrLf
    End With
    Debug.Print tmp
  Next

  '使用した各種オブジェクトを後片付けする。'
  Set tgtClass = Nothing
  Set tgtClassSet = Nothing
  Set tgtServices = Nothing
  Set currLocator = Nothing
End Sub

残された課題

さて。上掲リスト１を実際にVBEで入力してみるとわかることなのだが、For ～ Eachループの中、すなわち、個別のプリンタを指し示すオブジェクト（変数tgtClassにぶち込まれている）については、入力補完が効かない。

もし、これが不便だと感じるのならば、たとえばSWbemObjectをラップしたクラスを作って、Win32_Printerクラスのプロパティ・メソッドを自力で実装する、という手もあるかも知れない。

www.wmifun.net

ここを見たらできるはず。

おわりに

まあ、WMIを以てしても、プリンタ名の「on ～」の部分は取得できないっぽいので、そこまでムキになることもないかな。

写経の一環としてやってみたら面白いかも知れませんけど。

自作クラスのデフォルトメンバに関する大発見 その２

自作クラスのデフォルトメンバに関する発見　その２

このとき

akashi-keirin.hatenablog.com

から10箇月の時を経て、またまた世紀の大発見をしたので、紹介します。

あのときの方法

詳しくはコチラを読んでいただきたいが、早い話が、

インスタンスを突っ込んだ変数をカッコでくくれば、オブジェクト型のデフォルトメンバが発動する

ということ。

たとえば、WorksheetオブジェクトをラップしたPoweredSheetクラスのデフォルトメンバSelfメソッドが、ラップされているWorksheetオブジェクトを返すとする。

このとき、

Dim Sh As Worksheet
Set Sh = ActiveSheet
Dim ps As PoweredSheet
Set ps = New PoweredSheet
Call ps.init(Sh)

のようにしたとしても、変数psをWorksheet型の引数として別メソッドに渡すことはできない。

たとえば、

Private Function getSheetName( _
             ByVal TargetSheet As WorkSheet) As String
  getSheetName = TargetSheet.Name
End Function

というメソッドがあったとして、このメソッドに

Debug.Print getSheetName(ps)

と、psを引数として渡してもだめである。

しかし、

Debug.Print getSheetName((ps))

このように、変数psをカッコでくくってやると、ちゃんと動く。

これが、前回の発見であった。

今回の発見

今回の発見は、次の通り。

すなわち、

変数の後ろにカッコをつけてもデフォルトメンバが呼ばれる

これである。

先の例で言えば、

Debug.Print getSheetName(ps())

こうすれば良いのである。

ほれ、この通り。

空の丸カッコを付けるのは、プログラマにとっては違和感がないと思う。

おわりに

ただ、ちょっと残念なのは、ps().まで打ち込んだときに出てくる入力候補がWorksheetクラスのものではなく、あくまでもPoweredSheetのものになってしまう点。

実に残念。（Name2はPoweredSheetクラスに設置したデタラメなプロパティ。）

VBAでプリンタを変更する

プリンタの切り替え

VBAで、使用中のプリンタを切り替える方法。

目次

• かつての考え方
• こんな方法があったのか
• おわりに

かつての考え方

Application.ActivePrinterプロパティで切り替える

VBAでプリンタを切り替えるには、Application.ActivePrinterプロパティの値を変えるしかないと思い込んでいた。

しかし、この方式には難点がある。

Apploication.ActivePrinterプロパティの難点

Application.ActivePrinterプロパティでプリンタを切り替えるときには、

Application.ActivePrinter = "JUST PDF 3 on Ne02:"

のように、プリンタ名だけでなく、「on Ne02:」の部分も渡さなければならない。

この「on」以下の部分がくせ者で、どうやって取得したらよいのかわからなかった。

強引な解決策

だから、以前、

akashi-keirin.hatenablog.com

このような、実に乱暴な対応を考えたのだった。

とりあえず、このやり方なら、「on」以下の部分が、「on NeXX:」か、「on nul:」になっているなら、（時間は少々かかってしまうが、）取得は可能だ。

問題点

しかし、このやり方には当然問題がある。

上記のように、「on」以下の部分が、「on NeXX:」か「on nul:」でなかったとしたら対応できない、ということだ。

こんな方法があった

ところが、実に簡単な解決策があった。

Worksheet.PrintOutメソッドの引数で切り替える

見出しのように、Worksheet.PrintOutメソッドの引数でプリンタを指定するという方式である。

実は、Worksheet.PrintOutメソッドの引数ActivePrinterに渡すのは、プリンタ名だけで良い。

上記の例でいえば、

Dim Sh As Worksheet
Set Sh = ActiveSheet
Call Sh.PrintOut(ActivePrinter:="JUST PDF 3")

だけで良いのである。

プリンタ名を取得するだけなら割と簡単にできる。（ShellとかWMIを使う。）

この方法なら「on Ne:XX」について調べなくてもプリンタを切り替えることが出来て便利だ。

Application.ActivePrinterプロパティの値は切り替わってしまう

ただし、（当然のことながら、）この方法で印刷をすると、Application.ActivePrinterの値は変わってしまう。

Private Sub test02()
  Dim Sh As Worksheet
  Set Sh = ActiveSheet
  Debug.Print "印刷前　：" & Application.ActivePrinter
  Call Sh.PrintOut(ActivePrinter:="JUST PDF 3")
  Debug.Print "印刷後　：" & Application.ActivePrinter
End Sub

こんなふうに。

解決策

とはいえ、対応は実に簡単。前もってApplication.ActivePrinterの値を取得しておき、印刷後、元に戻してやればよろしい。

Private Sub test02()
  Dim Sh As Worksheet
  Set Sh = ActiveSheet
  Dim orgPrinter As String
  orgPrinter = Application.ActivePrinter
  Debug.Print "印刷前　：" & Application.ActivePrinter
  Call Sh.PrintOut(ActivePrinter:="JUST PDF 3")
  Debug.Print "印刷直後：" & Application.ActivePrinter
  Application.ActivePrinter = orgPrinter
  Debug.Print "戻したよ：" & Application.ActivePrinter
End Sub

こいつを実行すると、

こんなふうにJUST PDF 3で印刷を実行し、終了後のイミディエイト・ウィンドウには、

このように出力される。

おわりに

あの苦労は一体何だったのか。

範囲内でのセルの相対位置を求める

セルの範囲内での相対位置を求める

特定のセルが、指定範囲内の上から何番目にあるのかを求める必要があったので作った。

「指定範囲」は１列、「特定のセル」は１個限定。

セルの相対位置を返すFunction

とりあえず、指定範囲を上から順に当たっていって、対象のセルの位置を見つけたときの順番を表す数を返したらいいと思った。

リスト１　標準モジュールRangeUtil

Public Function getRelativePosition( _
                  ByVal TargetRange As Range, _
                  ByVal Target As Range) As Long  '……(1)'
  Dim ret As Long
  ret = 0
  'Guard clause'
  If TargetRange.Columns.Count > 1 Then GoTo Finalizer  '……(2)'
  If Target.Count > 1 Then GoTo Finalizer
  Dim rng As Range
  Set rng = Application.Intersect(TargetRange, Target)
  If rng Is Nothing Then GoTo Finalizer
  
  'Main process'
  Dim i As Long
  Dim addressStr As String
  For i = 1 To TargetRange.Rows.Count  '……(3)'
    If TargetRange.Cells(i, 1).Address = Target.Address Then
      ret = i
      Exit For
    End If
  Next
  
  'Return value'
Finalizer:
  getRelativePosition = ret
End Function

まず、(1)の

Public Function getRelativePosition( _
                  ByVal TargetRange As Range, _
                  ByVal Target As Range) As Long

で引数と返り値の設定。

引数TargetRangeでセル範囲を受け取り、引数Targetで位置を調べる対象のセルを受け取る。

ちなみに、引数名の記法はパスカル記法にした。組み込みの引数名とかぶらないように考えるのがめんどくさくなったから。

そのうち、メソッド名もパスカル記法に変える日が来ると思う。いまのところキャメル記法だけど。

(2)からの５行、

If TargetRange.Columns.Count > 1 Then GoTo Finalizer
If Target.Count > 1 Then GoTo Finalizer
Dim rng As Range
Set rng = Application.Intersect(TargetRange, Target)
If rng Is Nothing Then GoTo Finalizer

はガード節。

セル範囲が２列以上あるとき、位置を調べる対象セルが２個以上あるとき、セル範囲内に位置を調べる対象セルがないとき、にそれぞれ「0」を返すようにした。

(3)からの６行、

For i = 1 To TargetRange.Rows.Count
  If TargetRange.Cells(i, 1).Address = Target.Address Then
    ret = i
    Exit For
  End If
Next

が位置を調べる処理。

1からセル範囲の行数分だけループして、セルのアドレスが一致した時点でループを抜ける。

その時点での変数iの値が、〝上から何番目かを表す値〟になっているはず。

使ってみる

まず、

こんなセル範囲を用意する。

A1セル～A14セルまでの範囲に、「TargetRange」という名前が付けてある。

こうしておいて、次のコードで実験してみる。

リスト２　標準モジュールModuleMain

Private Sub detectRelativePosition()
  Dim relPos As Long
  relPos = RangeUtil.getRelativePosition( _
                       TargetRange:=Sh01.Range("TargetRange"), _
                       Target:=Selection)
  If relPos < 1 Then
    Call Provoke.makeUserSick( _
                   Message:="選択箇所がおかしいわボケｗｗｗ", _
                   MsgBoxIcon:=mbiCritical, _
                   Title:="残念ｗｗｗ")
    Exit Sub
  End If
  Call Provoke.makeUserSick( _
                 Message:="お前が選んだセルは、範囲内の上から" & _
                          CStr(relPos) & "番目やｗｗｗ。", _
                 MsgBoxIcon:=mbiInformation, _
                 Title:="選択セルの範囲内相対位置を調べた結果ｗｗｗ")
End Sub

選択しているセルが、「TargetRange」と名付けたセルの上から何番目にあるのかを、ちょっと腹の立つメッセージボックスで表示するというだけのプログラム。

ちなみに、コード中のProvokeというのは標準モジュールの名前で、その中にmakeUserSickというメソッドを書いている。（標準モジュールProvoke内のコードは後掲する。）

こいつを、

こんなふうに配置したコマンドボタンに登録して使う。

動作風景

こんな風に動作する。

おわりに

もしかして、セル範囲内の相対位置を返す組み込みの関数とかそういうのがあったりするんでしょうか？

註

標準モジュールProvoke

Option Explicit

Public Enum MsgBoxIcon
  mbiCritical = vbCritical
  mbiExclamation = vbExclamation
  mbiInformation = vbInformation
  mbiQuestion = vbQuestion
End Enum

'///ち～んｗ用'
Private Const MAKE_USER_SICK_2013 As String = _
              "       ＿＿＿＿＿＿＿" & vbCrLf & _
              "   ／　　　　　　　＼" & vbCrLf & _
              "／　／・＼　　／・＼　＼" & vbCrLf & _
              "|　　￣￣　 　￣￣　　 |　　　ち～んｗ" & vbCrLf & _
              "|　　　　（＿人＿）　  |" & vbCrLf & _
              "|　　　　　＼　 |　　　|" & vbCrLf & _
              "＼　　　　　＼_|　　／"

Private Const MAKE_USER_SICK_2010 As String = _
              "    　＿＿＿＿＿＿＿" & vbCrLf & _
              "　／　　　　　　　        ＼ " & vbCrLf & _
              "／　／・＼　　／・＼  　  ＼" & vbCrLf & _
              "|　　￣￣　　　￣　　　      |　ち～んｗ" & vbCrLf & _
              "|　　　　（＿人＿）　　     |" & vbCrLf & _
              "|　　　　　＼ 　   |      　   |" & vbCrLf & _
              "＼　　　　 　＼＿|　      ／"

'///ユーザーを煽るAAを表示する'
Public Sub makeUserSick( _
               Optional ByVal Message As String, _
               Optional ByVal MsgBoxIcon As MsgBoxIcon, _
               Optional ByVal Title As String)
  If Message = "" Then Message = "涙拭けよｗｗｗ"
  Dim ver As String
  ver = Application.Version
  Dim str As String
  Select Case ver
    Case "14.0"
      str = MAKE_USER_SICK_2010
    Case "15.0"
      str = MAKE_USER_SICK_2013
    Case "16.0"
      str = MAKE_USER_SICK_2013
    Case Else
      str = MAKE_USER_SICK_2010
  End Select
  Call MsgBox(Prompt:=Message & vbCrLf & str, _
              Buttons:=MsgBoxIcon, _
              Title:=Title)
End Sub

VBAでWordドキュメントに行番号を振る

VBAでWordドキュメントに行番号を振る

最近、〈脱・パワポ運動〉の一環として、説明用資料の類をWordで作成するようにしています。

パワポで作るいわゆる「ポンチ絵」のわかりにくさ／非効率を解消するのが目的です。

Wordで作成したドキュメントの「参照指示性」を劇的に上げるための方法が、『シラバス論』の著者、芦田宏直氏が発明した、〈Wordで作成したドキュメント全体に通しで行番号を振る〉というものです。

これ、アホみたいに簡単なんですけど、効果は絶大！

お試しあれ。

文書全体に通しで行番号を振る

これは、めっちゃ簡単。

こういう、ごく普通の文書があるとする。

「ページ レイアウト」タブから

「行番号」を選択し、

「連続番号」を選択すると、

ほれ、このとおり、通しの行番号が振られる。

めちゃくちゃ簡単。たったこれだけのことで、資料の「参照指示性」は飛躍的に高まる。「（○ページの）〇〇行目のところを話しますね。」で済む。

パワポのポンチ絵だとこうはいかない。「えっと、○ページの左上のコマの真ん中やや右のあたりに……」みたいになってわけがわからなくなる。

LineNumberingオブジェクト

この行番号機能を司るのは、VBAの場合、「LineNumberingオブジェクト」というらしい。

「Word2013 developer docs」（Word2013のオフラインヘルプ）によると、

LineNumbering Object (Word)

Represents line numbers in the left margin or to the left of each newspaper-style column.

Remarks

Use the LineNumbering property to return the LineNumbering object. The following example applies line numbering to the text in the first section of the active document.

VBA
With ActiveDocument.Sections(1).PageSetup.LineNumbering 
 .Active = True 
 .CountBy = 5 
 .RestartMode = wdRestartPage 
End With

The following example applies line numbering to the pages in the current section.

VBA
Selection.PageSetup.LineNumbering.Active = True

ということらしい。

どうやら、[Document].[Section].PageSetupオブジェクトのLineNumberingを参照したら得られるLineNumberingオブジェクトが司っているものらしい。

LineNumberingオブジェクトには、八つのプロパティがある。

同じく「Word2013 developer docs」によると、

Name	Description
Active	True if line numbering is active for the specified document, section, or sections. Read/write Long.
Application	Returns an Application object that represents the Microsoft Word application.
CountBy	Returns or sets the numeric increment for line numbers. Read/write Long.
Creator	Returns a 32-bit integer that indicates the application in which the specified object was created. Read-only Long.
DistanceFromText	Returns or sets the distance (in points) between the right edge of line numbers and the left edge of the document text. Read/write Single.
Parent	Returns an Object that represents the parent object of the specified LineNumbering object.
RestartMode	Returns or sets the way line numbering runs -- that is, whether it starts over at the beginning of a new page or section or runs continuously. Read/write WdNumberingRule.
StartingNumber	Returns or sets the starting line number. Read/write Long.

となっている。

総行番号にする場合だと、

• StartingNumberプロパティを1に、
• CountByプロパティを1に、
• RestartModeプロパティをwdRestartContinuousに、
• ActiveプロパティをTrueに

したらよさげ。

ドキュメントに総行番号を振るコード

ThisDocumentに総行番号を振るだけのコードを示す。

リスト１　標準モジュール

Private Sub activateLineNumbering()
  Dim lnNumbering As LineNumbering    '……(*)'
  Set lnNumbering = ThisDocument.Sections(1).PageSetup.LineNumbering
  With lnNumbering
    .StartingNumber = 1
    .CountBy = 1
    .RestartMode = wdRestartContinuous
    .Active = True
  End With
End Sub

通常、(*)のところは、オフラインヘルプのサンプルコードのように

With ThisDocument.Sections(1).PageSetup.LineNumbering

とでも書くのだろうけれど、「LineNumberingオブジェクトを使っているんだ！」という意識を高めるために（笑）、あえて変数に突っ込んで使っている。

ちなみに、ActiveプロパティがなんでBoolean型でなくてLong型なのかはわからん。

実行

リスト１を実行してみる。

この状態で実行すると、

バッチリ。

おわりに

これで、たくさんのWordドキュメントに一気に行番号表示させることができる。

Rangeオブジェクトの終端があるParagraphオブジェクトのインデックス番号を返すFunction(Word)

Rangeオブジェクトの終端があるParagraphオブジェクトのインデックス番号を返すFunction

更新頻度ガタ落ちですが、またしてもWordVBAネタです。

まずはコードを

お急ぎの方は、コードをコピッペして使ってください。

リスト１

Public Function getParagraphIndex( _
            ByVal tgtRange As Range) As Long
  Dim ret As Long
  tgtRange.Start = 0
  ret = tgtRange.Paragraphs.Count
  getParagraphIndex = ret
End Function

たったこんだけ。正味２行ｗ

まさかこんなに簡単にできるとは思っていませんでした。

使ってみる

たとえば、テキトーなドキュメントを用意して、

こんなふうにテキトーに範囲を選択しておく。

画像では、４～５段落にまたがった範囲を選択している。

で、イミディエイト・ウィンドウに次のコードを書いて[Enter]を押す。

?getParagraphIndex(Selection.Range)

すると、

ちゃんと「5」が出力されておる。

バッチリ！

解説

こんなしょうもないコードだが、二つも発見があった。

短いコードなので再掲する。

リスト１（再掲）

Public Function getParagraphIndex( _
            ByVal tgtRange As Range) As Long
  Dim ret As Long
  tgtRange.Start = 0  '……(1)'
  ret = tgtRange.Paragraphs.Count  '……(2)'
  getParagraphIndex = ret
End Function

Start（End）プロパティはRead/Writeだった

これは、完全に思い込み。

勝手にRead onlyだと固く信じて疑っていなかった。

Microsoft Docsの「Range.Start Property」の項にも、

Range.Start property (Word)

Returns or sets the starting character position of a range. Read/write Long.

と明記してあるし。

(1)の

tgtRange.Start = 0

によって、tgtRangeが指し示すRangeオブジェクトの始端をドキュメントの先頭にしているわけだ。

RangeオブジェクトにもParagraphsコレクションがある

これも全然知らなかった。

「Paragraphs」というぐらいだからてっきりDocumentオブジェクトの直参だと思っていた。

これまた、Microsoft Docsの「Range.Paragraphs Property」の項にはっきりと

Range.Paragraphs property (Word)

Returns a Paragraphs collection that represents all the paragraphs in the specified range. Read-only.

と書いてある。

つまり、(1)を実行した段階で、tgtRangeが指し示すRangeオブジェクトの範囲は、〈ドキュメントの始端～選択範囲の終端〉になっているわけなので、(2)の

ret = tgtRange.Paragraphs.Count

によって、〈ドキュメントの始端～選択範囲の終端〉に含まれる段落数、すなわち選択範囲の終端がある段落が先頭から数えて何番目か、を表す数値が変数retに返る、というわけだ。

最初にこのアイディアを考えついたやつは天才だと思う。

おわりに

世の中、天才だらけでいやになるぜ。

追記（2022/02/18）

実は、ここで示したコードには重大なバグがあります。

なんと、段落の先頭にカーソルを置いて、引数tgtRangeにSelection.Rangeを渡すと、一つ前の段落のインデックスを返してしまうのです。

取り急ぎ、応急処置をしたものを次に挙げておきます。

Public Function GetParagraphIndex( _
            ByVal a_Target As Range) As Long
  Dim ret As Long
  Dim rng As Range
  Set rng = a_Target
  rng.Start = 0
  ret = rng.Paragraphs.Count
  Dim pos As Long
  pos = rng.End
  If pos = 0 Then GoTo ReturnValue
  Dim char As String
  char = rng.Parent.Range(pos - 1, pos).Text
  If char = Chr(13) Then
    ret = ret + 1
  End If
ReturnValue:
  GetParagraphIndex = ret
End Function

この記事を書いた当時から、コーディングスタイルが変わったので、ちょっと書きぶりは違いますが。

一応、引数a_Targetで渡されたRangeオブジェクトのStartプロパティを0にしたときに、Rangeオブジェクトの終端が改段落だったら1を加算して返すようにしました。

これで良いのかどうか、引き続き検証します……。

参照元に参照先の通し行番号を書き込む(2)

参照元に参照先の通し行番号を書き込む(2)

たとえば、

みたいなドキュメントがあるとする。

参照指示性を高めるために、全ての行に通しで行番号を振っている。

これは、芦田宏直氏のアイディアで、詳しいことは氏の著書『シラバス論』（2019 晶文社）をご覧ください。

問題は、文中に「〇〇行目を参照」などと書いた場合。

「相互参照」機能を使えば、段落番号とかページ番号なんかは設定できるんだが、通しの行番号というのがない。

参照先の位置などというものは、編集の都合で揺れ動くものなので、「相互参照」的に設定できないのは非常につらい。

そこで、

akashi-keirin.hatenablog.com

このとき、ブックマークを利用して参照先の通しの行番号を割り出し、参照元の行番号の部分を書き換える方法を編み出した。

あとは、前回発覚した

ブックマーク部分の文字を書き換えたらブックマークが消滅する問題

を解消すればよろしい。

消滅するブックマークを復活させる考え方

まず、次のように考えた

1. 参照元の[Range].Textを書き換える前に、参照元のRangeオブジェクトを取得しておく
2. 参照元の[Bookmark].Range.Textを書き換える
3. Document.Bookmarks.Addメソッドを、参照元のブックマーク名、1.で取得したRangeオブジェクトを渡して実行する

これでうまくいく、と思った。

しかし、これではうまくいかない。

2.で参照元の[Bookmark].Range.Textを書き換えた時点で、1.で取得したRangeオブジェクトが潰れてしまっているのだ。

たとえば、「○行目」の「○」の部分（1文字選択の状態）だったはずのRangeオブジェクトが、2.で「48行目」というふうに書き換えたとすると、「48」の手前のカンチャン（0文字選択の状態）になってしまうのだ。

これではまずい。

そこで、次のような手順を踏むことにした。

1. 参照元の[Range].Textを書き換える前に、参照元のRangeオブジェクトを取得しておく
2. 参照元の[Bookmark].Range.Textを書き換える
3. 1.で取得したRangeオブジェクトについてSelectメソッドを実行する。（書き換えた行番号の手前にカーソルが移動する。）
4. Selection.MoveRightメソッドを用いて、行番号の文字数分だけカーソルを右に動かす。（右にドラッグする。）
5. Document.Bookmarks.Addメソッドを、参照元のブックマーク名、4.で取得したSelection.Rangeオブジェクトを渡して実行する

こんなふうにした。

参照先の行番号に応じて参照元を書き換えるメソッド

上記の考えに基づいて作成したメソッドがコチラ。

リスト１

Public Sub refreshLineNumberReference( _
             ByVal TargetDocument As Document, _
             ByVal ReferrerName As String, _
             ByVal ReferenceName As String)
'### 参照先ブックマークのある行番号を取得して、参照元 ###'
'### ブックマークの箇所の行番号を書き換える           ###'
  '///ReferrerName  :参照元ブックマーク名'
  '///ReferenceName :参照先ブックマーク名'
  Dim Doc As Document
  Set Doc = TargetDocument
  '参照先、参照元ブックマークが存在しなかったらExit'
  If Not bookmarkExists(Doc, ReferenceName) Then Exit Sub
  If Not bookmarkExists(Doc, ReferrerName) Then Exit Sub
  'メインの処理'
  '参照元ブックマークを取得'
  Dim bmFrom As Bookmark
  Set bmFrom = Doc.Bookmarks(ReferrerName)
  '参照先の行番号を取得'
  Dim lineNum As Long
  lineNum = getLineNumber(Doc.Bookmarks(ReferenceName).Range)
  '参照元のRangeオブジェクトを取得'
  Dim tgtRange As Range
  Set tgtRange = bmFrom.Range
  '参照元の行番号を書き換える'
  Dim tmp As String
  tmp = CStr(lineNum)
  bmFrom.Range.Text = tmp
  '参照元ブックマークが消滅しているので、復元する'
  'Rangeオブジェクトが潰されてしまっているので、行番号を表す'
  '文字数分右に広げてRagneオブジェクトを取得し直す'
  Call tgtRange.Select
  Call Selection.MoveRight(wdCharacter, Len(tmp), wdExtend)
  Set tgtRange = Selection.Range
  '再度ブックマークを設定する'
  Call Doc.Bookmarks.Add(ReferrerName, tgtRange)
End Sub
Private Function bookmarkExists( _
             ByVal tgtDoc As Document, _
             ByVal tgtName As String) As Boolean
  '///ブックマーク名の存否を確認'
  bookmarkExists = True
  Dim i As Long
  For i = 1 To tgtDoc.Bookmarks.Count
    If tgtDoc.Bookmarks(i).Name = tgtName Then
      Exit Function
    End If
  Next
  bookmarkExists = False
End Function

Public Function getLineNumber( _
            ByVal tgtRange As Range) As Long
  Dim ret As Long
'///tgtRangeのあるページ番号を取得'
  Dim currPage As Long
  currPage = tgtRange.Information(wdActiveEndPageNumber)
  'tgtRangeのあるページ内での行番号を取得'
  Dim currLine As Long
  currLine = tgtRange.Information(wdFirstCharacterLineNumber)
  'tgtRangeが1ページ目にあるときは、その行番号を返す'
  If currPage = 1 Then
    ret = currLine
    GoTo Finalizer:
  End If
  '2ページ以上ある時は、手前のページまでの累計を足さなければいけない'
  Dim Doc As Document
  Set Doc = tgtRange.Parent
  'カーソル位置を記録'
  Dim orgRange As Range
  Set orgRange = Selection.Range
  '文書の先頭にカーソルを置く'
  Call Doc.Range(0, 0).Select
  '1ページ目の最終位置を取得'
  Dim pageEnd As Long
  '1ページ目の最終位置を選択'
  Dim i As Long
  For i = 1 To currPage - 1
    pageEnd = Doc.Bookmarks("\Page").End
    Call Doc.Range(pageEnd - 1, pageEnd - 1).Select
    ret = ret + Selection.Range.Information(wdFirstCharacterLineNumber)
    '次のページの先頭へ'
    Call Selection.MoveRight(wdCharacter, 1, wdMove)
  Next
  ret = ret + currLine
  'カーソル位置を戻す'
  Call orgRange.Select
Finalizer:
  getLineNumber = ret
End Function

Rangeオブジェクトのある通し行番号を返すメソッドのコードを再掲したので、異様にタテ長になってしまったが、気にしないでくだされ。

今回もかなり細かくコメントを入れたので、説明は省略。

使ってみる

このように、参照先と参照元にそれぞれ「参照先01」、「参照元01」という名前のブックマークを設定し、次のコードで使ってみる。

リスト２

Private Sub test00()
  Dim Doc As Document
  Set Doc = Application.ActiveDocument
  Call LineNumUtil.refreshLineNumberReference( _
                     Doc, _
                     "参照元01", _
                     "参照先01")
End Sub

ほれ。このように、ちゃんと参照先の行番号に置き換わっておる。

さらに、参照先をテキトーに動かしてから実行しても、ちゃんと参照先の行番号に置き換わっておる。

おわりに

やはりWordのRangeオブジェクトは癖が強い。まだまだ理解が足りないな……。

もっとわかってきたら、洗練されてくると思う。