行高を適切に（？）調整する(Excel)

行高を適切に（？）調整する(Excel)

印刷時に行が切れてしまわないようにする方法を考えた。

考え方

フォントには、固有の行高がある。単位はポイント。で、Excelの行の高さ（[Range].RowHeightプロパティの値）も単位はポイント。だから、次のような考え方で行けるはず。

• フォントの固有の高さを求める
• セルの中で一行あたり何文字になるのかを求める
• セル内の文字数とか改行回数をもとに何行になるのかを求める
• 上下の余白を何ポイント取るのか決める

まあ、これでよかろう。

フォントの固有の高さを求める

これは、よくわからんので、使いたいフォントを指定し、使いたいフォントサイズに変えて、行の境目をダブルクリックしてみた。

たとえば、「UD デジタル 教科書体 NK-R」で「11ポイント」を指定すると、

このように、行高は15ポイントになった。まあ、これでよかろう。（もし違っていたら教えろ教えてください。）

セルの中での一行あたり文字数を調べる

これは、どうすればよいか分からなかったので、数えたｗ

PDF化して、目視で数えましたとも。だいたい、55とか56とか、その辺ｗ

セル内の文字数とか改行回数をもとに何行になるのかを求める

セル内改行がなかったら楽勝なんだが、セル内改行を加味するとなるとめんどくさい。

次のように考えた。

• セル内に改行記号がなかったら、単純に(文字数 \ 一行あたり文字数) + 1でよい。
• セル内に改行記号がある場合は、文字列を先頭からスキャンし、一行あたり文字数に達するか、改行文字にぶつかったらカウントアップする

こんな感じ。

「一行あたり文字数に達するか、改行文字にぶつかったらカウントアップする」という処理は、コードを示した方が早いので示す。

リスト１

Private Function getLinesCount( _
             ByVal tgtCell As Range) As Long
  Dim i As Long
  Dim ret As Long
  ret = 1
  Dim cnt As Long
  cnt = 0
  Dim tgtStr As String
  With tgtCell
    tgtStr = .Value
    For i = 1 To Len(tgtStr)
      cnt = cnt + 1
      '改行文字にぶつかったらcntをリセットして行数をイン'
      'クリメント'
      If Mid(tgtStr, i, 1) = vbLf Then
        cnt = 0
        ret = ret + 1
        GoTo Continue
      End If
      'cntが１行あたり文字数に達したらcntをリセットして'
      '行数をインクリメント'
      If cnt Mod chrCntPerLine = 0 Then
        cnt = 0
        ret = ret + 1
      End If
Continue:
    Next
  End With
    getLinesCount = ret
End Function

途中出てくるchrCntPerLineは、一行あたり文字数を入れておく変数。モジュールレベル変数にしているので、宣言がない。決してさんたろう方式ではないので誤解のなきよう。

上下の余白を何ポイント取るのか決める

「決める」といっても、上○ポイント、下○ポイントみたいに決めることは（たぶん）できないので、期待しないように。

垂直方向を中央揃えにしておけば、上下に均等にマージンを入れるぐらいならできる、という意味。

たとえば、行数 × 一行あたりの行高 で求めた値に10を足してやれば、上下5ポイントづつマージンができる。ただそれだけだ。

行高を調整するメソッド

めんどくさいので完成したコードを示す。

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

Option Explicit

'Module Level Variables'
Private fntHeight As Single
Private chrCntPerLine As Long
Private tpbtmMargin As Single

'Methods'
Public Sub adjustRowHeight(ByVal targetCell As Range, _
                           ByVal FontHeight As Single, _
                           ByVal CharCountPerLine As Long, _
                           ByVal TopBottomMargin As Single)
  If targetCell.Value = "" Then Exit Sub
  fntHeight = FontHeight
  chrCntPerLine = CharCountPerLine
  tpbtmMargin = TopBottomMargin
  Dim linesCount As Long
  Dim tgtRowHeight As Single
  With targetCell
    'セル内改行がされていなければ、文字数だけで行数を判定する'
    If InStr(1, .Value, vbLf) = 0 Then
      linesCount = (Len(.Value) \ chrCntPerLine) + 1
    'セル内改行があるときは、1文字づつスキャンして行数を判定する'
    Else
      linesCount = getLinesCount(targetCell)
    End If
    tgtRowHeight = (linesCount * fntHeight) + tpbtmMargin
    '親のWorksheetオブジェクトを取得'
    Dim tgtSh As Worksheet
    Set tgtSh = .Parent
    tgtSh.Rows(.Row).RowHeight = tgtRowHeight
  End With
End Sub

Private Function getLinesCount( _
             ByVal tgtCell As Range) As Long
  Dim i As Long
  Dim ret As Long
  ret = 1
  Dim cnt As Long
  cnt = 0
  Dim tgtStr As String
  With tgtCell
    tgtStr = .Value
    For i = 1 To Len(tgtStr)
      cnt = cnt + 1
      '改行文字にぶつかったらcntをリセットして行数をイン'
      'クリメント'
      If Mid(tgtStr, i, 1) = vbLf Then
        cnt = 0
        ret = ret + 1
        GoTo Continue
      End If
      'cntが１行あたり文字数に達したらcntをリセットして'
      '行数をインクリメント'
      If cnt Mod chrCntPerLine = 0 Then
        cnt = 0
        ret = ret + 1
      End If
Continue:
    Next
  End With
    getLinesCount = ret
End Function

行高を調整することに特化したモジュールを作った。

使ってみる

こんなふうにして行高を調整しても、画面上ではきれいにととのっているが、PDF化（印刷）してみると、

この体たらく。とほほ。

それが！

上記メソッドを用いて処理すると、

こうなって、PDF化（印刷）してみると、

バッチリ！

おわりに

だいぶまえにちゅん氏（id:Kotori-ChunChun）もやっていたような気がするので、勉強しに行きます。

表の中でのセルの位置を特定する(Word)

表の中でのセルの位置を特定する(Word)

Excelの表に比べて、Wordの表は勝手に改竄されることが今まで少なかったので、完全に油断していた。

Wordで集めた大量のドキュメント。ファイル名の付け方がバラバラなので、整理が大変。そこで、ドキュメント内に記入されている情報を元に、ファイル名をリネームすることにしたのです。たとえば、[会員番号] - [名前].docxみたいに。

あくまでも急場しのぎのマクロだし、そもそもWordの表に勝手に行や列を挿入するやつもまれだったので、「会員番号」とか「名前」を取得する表のインデックスとか、行番号、列番号なんて決め打ちで十分と思っていた。

しかし、現れやがったんですよ。強者が。

勝手に名前記入欄をすぐ下の表に接着するやつ

とか、

勝手に新しい表を挿入するやつ

なんかが・゜・(ﾉД`)・゜・。

しかも、一人や二人やない。ちょいちょい処理が止まる……。

とりあえず、その場は応急処置で乗り切ったが、この際なので一般化できるようにWordのTableオブジェクトについて勉強しておくことにした。

とりあえずキーワードを含むセルを返すFunctionを作る

今回の場合だと、まずは、たとえば、「会員番号」という文字列のあるセルを特定したい。

考え方

で、次のように考えた。

• ドキュメント内のTableオブジェクトを全て巡回
• Tableオブジェクト内のCellオブジェクトを総当たり
• CellオブジェクトのRange.Textプロパティがキーワードを含んでいたら、そのCellオブジェクトを返す

ひとまずこんな感じ。

コード

ドキュメント内の全ての表のセルを巡回して、キーワードがヒットしたらそのセルを返すFunction。

リスト１

Public Function getCell( _
            ByVal KeyWord As String, _
   Optional ByVal tgtDoc As Document) As Cell
  Dim ret As Cell
  Set ret = Nothing
  '引数tgtDocが省略されていたらActiveDocumentをセット'
  If tgtDoc Is Nothing Then
    Set tgtDoc = ActiveDocument
  End If
  '全Tableを巡回'
  Dim tbl As Table
  For Each tbl In tgtDoc.Tables
    Set ret = getFoundCell(tbl, KeyWord)
    If Not ret Is Nothing Then Exit For
  Next
  Set getCell = ret
End Function
'Table内の全セルを巡回。キーワード見つけ次第return'
Private Function getFoundCell( _
             ByVal tgtTable As Table, _
             ByVal KeyWord As String) As Cell
  Dim ret As Cell
  Dim r As Long
  Dim c As Long
  Dim tmp As String
  For r = 1 To tgtTable.Rows.Count
    For c = 1 To tgtTable.Columns.Count
      'Cellオブジェクトを取得'
      Set ret = tgtTable.Cell(r, c)
      'セル内の文字列を取得'
      tmp = ret.Range.Text
      '右端のBELと改行コードを除去'
      tmp = Left(tmp, Len(tmp) - 2)
      'キーワードを含んでいたらreturn'
      If InStr(1, tmp, KeyWord) > 0 Then
        GoTo Finalizer
      End If
    Next
  Next
  Set ret = Nothing
Finalizer:
  Set getFoundCell = ret
End Function

とりあえずこんな感じ。本当なら、キーワードとセル内文字列の比較について、完全一致とか前方一致とかが選べるようにしたいけれど、ひとまず後回し。

使ってみる

このようなドキュメント（笑）を用意して、次のコードで使ってみる。

リスト２

Private Sub test01()
  Dim tgtCell As Cell
  Set tgtCell = getCell("会員番号")
  Debug.Print tgtCell.RowIndex
  Debug.Print tgtCell.ColumnIndex
End Sub

こいつを実行すると、イミディエイト・ウィンドウに、

このように表示された。

うむ。バッチリである。

ついでにオフセットしたセルを取得するFunctionを作る

CellオブジェクトのParentプロパティを参照すれば、

この画像でおわかりのように、親のTableオブジェクトを取得することができる。

Cellオブジェクトからは、表の中での行番号、列番号を返すRowIndex、ColumnIndexプロパティがある。

……ということは、ExcelのOffsetプロパティみたいなことができるはずだ。

よーし。作っちゃえ！

考え方

次のような仕様にすれば良い。

• Cellオブジェクトと、行・列それぞれのオフセットサイズを受け取る
• CellオブジェクトのParentプロパティを参照してTableオブジェクトを取得する
• 行・列のオフセットサイズを元に、取得したいCellオブジェクトの表内での位置を求める
• [Table].Cellメソッドで、取得したいCellオブジェクトを取得する

こんな感じ。

コード

上記のような考え方でコーディングした。

リスト３

Public Function getOffsetCell( _
            ByVal tgtCell As Cell, _
            ByVal RowOffset As Long, _
            ByVal ColumnOffset As Long) As Cell
  Dim ret As Cell
  Set ret = Nothing
  Dim currTable As Table
  Set currTable = tgtCell.Parent
  Dim r As Long
  r = tgtCell.RowIndex + RowOffset
  'rの値がおかしくなったらNothingを返す'
  If r < 1 Then GoTo Finalizer
  If r > currTable.Rows.Count Then GoTo Finalizer
  Dim c As Long
  c = tgtCell.ColumnIndex + ColumnOffset
  'cの値がおかしくなったらNothingを返す'
  If c < 1 Then GoTo Finalizer
  If c > currTable.Columns.Count Then GoTo Finalizer
  'オフセットしたセルを返す'
  Set ret = currTable.Cell(r, c)
Finalizer:
  Set getOffsetCell = ret
End Function

うむ。これで良い。

使ってみる

このドキュメント（笑）から、会員番号を取得して見せよう。

リスト４

Private Sub test02()
  Dim tgtCell As Cell
  Set tgtCell = getOffsetCell(getCell("会員番号"), 0, 1)
  Debug.Print tgtCell.Range.Text
End Sub

行オフセットサイズを0、列オフセットサイズを1にしているので、一つ右のセル、すなわち会員番号を取得できるはずだ。

こいつを実行すると、イミディエイト・ウィンドウは、

うむ。

さらに、イミディエイト・ウィンドウに

?getOffsetCell(getCell("名前"), 0, 1).Range.Text

と入力して[Enter]を押すと、

うむ。完璧である!!!!!!!!

おわりに

アクロバチック入力に対抗するのはなかなか大変である……orz

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

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

Wordの本文中で、参照箇所を明示したいときがある。段落番号とか見出しだったら、「相互参照」機能を使って文中に挿入できて、変更にも追随してくれるから良いのだが、通し行番号だけは、どうにもやり方がわからなかった。（もし「標準機能にあるで！」というのがあれば教えろ教えてください。）

行番号の参照などというものは、常に揺れ動くものなので、手動で管理するのは死ぬほどめんどくさいし、絶対に修正漏れが起こる。そこで、「ブックマーク」機能を使って解消することを考えた。

基本的には前回

akashi-keirin.hatenablog.com

までの続きです。

Bookmarkオブジェクトを使う

考え方

「ブックマーク」という機能を使えば、文書中の任意の場所に名前を付けることができる。VBAでは、Bookmarkオブジェクトを操作することによって、「ブックマーク」機能を使うことができる。

そこで、次のように考えた。

• 参照先の箇所にブックマークを設定する
• 参照元の「○行目」の行番号の部分（「○」の部分。）にブックマークを設定する
• 前回作成したFunctionを用いて、参照先の通し行番号を取得する
• 取得した行番号を文字列型に変換して「○」の部分に上書きする

こんな感じ。

ブックマークの設定

とりあえず、今回は手動で設定する。

まずは参照先。

このように、64行目の先頭に「参照先01」というブックマークを設定。

次に参照元。

このように、「○行目」の「○」の部分に「参照元01」というブックマークを設定。

以上。

ブックマークした箇所（Rangeオブジェクト）の取得

まず、上記で設定したブックマークについて、Bookmarkオブジェクトを取得する方法。

これは、まずDocumentオブジェクトのBookmarksプロパティを参照してBookmarksコレクションを取得する。

んで、あとはItemメソッドのインデックスに取得したいブックマークの名前を指定すれば良い。

Itemは省略できるので、実際の書き方は

Document.Bookmarks("[ブックマーク名]")

になる。

Bookmarkオブジェクトが取得できれば、あとはそのRangeプロパティを参照すれば、ブックマークした箇所のRangeオブジェクトが取得できる。実に簡単。

参照元の文字を行番号に置き換える

参照元の「○」の部分をRangeオブジェクトとして取得しているのだから、あとはそのTextプロパティを書き換えたら良い。

楽勝！

コード

参照元に参照先の通し番号を挿入するコードは次の通り。

処理の中で、前回作成したgetLineNumberメソッドを呼び出しているので、そのコード（標準モジュールLineNumUtilに記載。）も再掲する。

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

Private Sub test00()
  Dim Doc As Document
  Set Doc = Application.ActiveDocument
  '参照元のブックマークオブジェクトを取得'
  Dim bm As Bookmark
  Set bm = Doc.Bookmarks("参照元01")
  '参照先ブックマークの通し行位置を取得'
  Dim lineNum As Long
  lineNum = LineNumUtil.getLineNumber(Doc.Bookmarks("参照先01").Range)
  '参照元のテキストを書き換える'
  bm.Range.Text = CStr(lineNum)
End Sub

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

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

例によって細かくコメントを入れたので、説明は省略。

うむ。これで盤石のはずだ！

使ってみる

リスト１を実行すると、

ウホッ！　完璧！

こんどは、

こんなふうにテキトーに参照先の位置をズレータにしておいて、再度実行！

な････なんだってーーー！？

キ、キバヤシ……。これは一体どういうことなんだよ……。

あふれる涙を抑えながら「ブックマーク」を調べると、

なんと、テキストを書き換えたブックマーク（参照元01）が消えとる……orz

おわりに

どうも間違えてロンしてしまったか、フリテンだったようだ。

もう一工夫必要だということだ。

WordVBAはおれを甘やかしてくれぬ……。

で、今回の教訓。

BookmarkオブジェクトのRange.Textを書き換えるとBookmarkオブジェクトは消滅する。

覚えておこう。

通しの行番号を取得するFunction(Word)

通しの行番号を取得するFunction(Word)

前回

akashi-keirin.hatenablog.com

の続き。

文書全体を通じての通しの行位置を取得するFunctionを作った

考え方

[Range].Informationプロパティを参照すれば、Rangeオブジェクトのあるページ位置（Information(wdActiveEndPageNumber)）とか、ページ内での行位置（Information(wdFirstCharacterLineNumber)）を取得することができる。

こいつらを組み合わせて、次のような手順で通しの行位置を取得することにする。

• Rangeオブジェクトのあるページ位置と、そのページ内での行位置を取得する
• ページ位置が1ページ目にある場合は、そのまま行位置を返す
• ページ位置が2ページ目以降にある場合は、1ページ目から一つ手前のページまでの行数を累計して加算する

こんな感じ。

ちなみに、各ページの行数を取得するのは、前回述べた方法を用いる。

コード

作成したコードは次の通り。

リスト１

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
  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オブジェクトを渡せば、そのRangeオブジェクトがある箇所の、文書内での通しの行位置（通し行番号の値）を取得することができる。

使ってみる

たとえば、

このように、通しの76行目（2ページ目にある。）にカーソルを置いた状態で、イミディエイト・ウィンドウに

?getLineNumber(Selection.Range)

と書いて[Enter]を押すと、

このように、ちゃんと「76」が返る。

また、Rangeオブジェクトは、Bookmarkオブジェクトからも取得できる（[Bookmark].Rangeプロパティ）ので、たとえば、

こんなふうに、64行目にある部分に「参照先01」という名前のブックマークを作成しておき、イミディエイト・ウィンドウに

?getLineNumber(ActiveDocument.Bookmarks("参照先01").Range)

と入力して[Enter]を押すと、

うむ。バッチリである！

おわりに

今回作成したFunctionをうまく使えば、文書中の「○行目参照」の「○」の部分を、参照先が移動しても正しく再設定するマクロが作れると思う。

リーチ！

各ページの行数を取得する(Word)

各ページの行数を取得する(Word)

Wordドキュメントの、各ページの行数を調べる方法を編み出した（笑）ので、覚書として記しておく。

カーソルのあるページの総行数を取得する

[Document].Bookmarks.Item("\Page")の返り値

BookmarksコレクションのItemメソッドのIndexに"\Page"を指定すると、カーソルのあるページ全体を表すBookmarkオブジェクトが返るっぽい。

たとえば、テキトーなページのどこかにカーソルを置いて、イミディエイト・ウィンドウに

ActiveDocument.Bookmarks("\Page").Select

と打ち込んで[Enter]してやると、カーソルがあるページ全体が選択された状態になる。

[Bookmark].Endプロパティ

BookmarkオブジェクトのEndプロパティは、そのページの最後の文字の、文書先頭から数えた位置を返す。

したがって、たとえば、

Dim Doc As Document
Set Doc = ThisDocument
Dim pageEnd As Long
pageEnd = Doc.Bookmarks("\Page").End
Call Doc.Range(pageEnd - 1, pageEnd - 1).Select  '……(*)'

このようにすると、カーソルを置いてあったページの一番最後の位置にカーソルを移動させることになる。

[Range].Informationプロパティ

カーソル位置のRangeオブジェクトは、

Selection.Range

とすれば取得できる。

で、RangeオブジェクトにはInformationというプロパティがあり、引数の指定次第で実に色々な情報を取得することができる。

たとえば、WdInformation列挙体のメンバであるwdFirstCharacterLineNumber（=10）を指定してやると、そのRangeオブジェクトの1文字目の場所の、ページ内での行番号を返してくれる。

つまり、上掲コードの(*)の段階で、ページ末尾が選択されているので、ここで

Selection.Range.Information(wdFirstCharacterLineNumber)

とすれば、そのページ内の総行数を取得できることになる。

次のページに移動する

これは簡単。

すでにカーソルはページの末尾にあるのだから、一つだけ右に移動すればよい。

カーソルを動かすには、SelectionオブジェクトのMoveRightメソッドを使う。

Call Selection.MoveRight(wdCharacter, 1, wdMove)

これだけ。

各ページの行数を取得するマクロ

上記の各項目を総合して、ドキュメントの各ページの行数を取得して、イミディエイト・ウィンドウに出力するマクロを作った。

リスト１

Private Sub test04()
  Dim Doc As Document
  Set Doc = ThisDocument
  '最初のカーソル位置を記録'
  Dim orgRange As Range
  Set orgRange = Selection.Range
  '文書の先頭を選択'
  Call Doc.Range(0, 0).Select
  '1ページ目の末尾の位置を取得'
  Dim pageEnd As Long
  pageEnd = Doc.Bookmarks("\Page").End
  '1ページ目の末尾を選択'
  Call Doc.Range(pageEnd - 1, pageEnd - 1).Select
  Dim n As Long
  n = 1
  Do
    'ページ末尾のページ内での行番号を出力'
    Debug.Print getPageNumber(n) & " page has " & _
                Selection.Range.Information( _
				wdFirstCharacterLineNumber) & _
                " lines."
    '文書の末尾に到達していたらExit'
    If pageEnd + 1 = Doc.Range.End Then Exit Do
    '一つ右へ。（次のページの先頭位置へ。）'
    Call Selection.MoveRight(wdCharacter, 1, wdMove)
    'ページの末尾位置を取得して選択'
    pageEnd = Doc.Bookmarks("\Page").End
    Call Doc.Range(pageEnd - 1, pageEnd - 1).Select
    'nをインクリメント'
    n = n + 1
  Loop
  '元のカーソル位置に戻す'
  Call orgRange.Select
End Sub

Private Function getPageNumber( _
             ByVal tgtPageNumber As Long) As String
  Dim ret As String
  Select Case tgtPageNumber
    Case 0: ret = "None"
    Case 1: ret = "1st"
    Case 2: ret = "2nd"
    Case 3: ret = "3rd"
    Case Else: ret = CStr(tgtPageNumber) & "th"
  End Select
  getPageNumber = ret
End Function

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

各ページを巡回して、そのページに何行あるかを語らせるマクロ。

もちろん、これだけでは何の役にも立たない。

実行

このようなドキュメントを準備。

1ページ目が42行、2ページ目が通し行番号で75行目まであるので、33行、ということになる。

上掲リスト１を実行すると、

バッチリ。

おわりに

これで野望にイーシャンテン。

次回の記事で野望にリーチがかかる予定。

参考

続きはコチラ。

akashi-keirin.hatenablog.com

動的リストの作成

動的リストの作成

前にいたことがある職場に今いる知人から相談を受けた。

秘伝のマクロが動かなくなって困っているらしい。

人助けのつもりでそのExcelを送ってもらって中を見てみた。

あー、確かにこんなのあったなー。おれは改造して使っていたけど。

簡単に言うと、

開始番号と終了番号を入力して実行すると、帳票にデータを次々に差し込んで印刷する

という、まあ差込印刷をExcelでやるようなやつ。

ただまあ、差し込むデータの数が番号ごとに異なるので、かなりめんどくさい処理を強引に書いている、というそんな秘伝マクロだった。

で、その

開始番号と終了番号を入力

の部分なんですけれど、無駄にInputBox関数なんか使っている。

しかも、開始番号を入力させるInputBoxには、

1～〇〇までの番号を半角で入力してください

とか、

存在しない番号を入力したら処理が止まります

とか書いてある。

もちろん、続けて出てくる終了番号を入力させるInputBoxには、

開始番号で入力した番号～〇〇までの番号を半角で入力してください

とか、

開始番号で入力した番号よりも小さな番号を入力すると処理が止まります

とか書いてある。

もう絵に描いたような

運用でカバー

だったのである。

「せっかくExcelでやってるんだから、セルに入力してもらったらええやん……。」と思った私は、さっそく改造することにした。

動的なリスト

InputBoxを使う代わりに、ユーザーフォームを使うという手もあるが、たかが入力を制限するだけのためにそこまでする必要もあるまい。

要するに、開始番号と終了番号が望ましい形でしか入力できないようにすればいいのだ。

ほれ、

Excelには「データの入力規則」という機能があるじゃないか！

ということですよ。

まずは静的リスト

たとえば、

こんなふうに表を用意しておいて、A2セルに「データの入力規則」を適用する。

「データ」タブから「データの入力規則」へと進み、

「設定」タブの「入力値の種類」のドロップダウンリストで「リスト」を選択。「元の値」のところに選択肢を並べたリスト範囲（今回の場合なら$D$1:$D$20）を指定してやればよい。

これで、静的なリストなら簡単に作ることができる。

ただし、これだけでは「自」に「至」よりも大きな数字を入れることができるため、困ったことになる。

そこで、動的リストの作成である！

動的なリスト

「自」欄（A2セル）で入力を許可する数値のリストを、「至」欄（B2セル）の値に応じて変化させたり、その逆をしたりしたい。

そこで、次のように考えた。

• 「データの入力規則」の「元の値」の指定にINDIRECT関数を用いる
• INDIRECT関数の引数にする参照アドレスの文字列を「自」欄・「至」欄の値に応じて変化させるセルを作る

およそこのような感じ。

こうすれば、「自」欄・「至」欄入力時に表示されるドロップダウンリストが動的なリストになる。

動的リストの作成

次のような補助セルが必要だと考えた。

1. 「自」リストの入力に応じて、「至」リストの上限を示すセルのアドレスを作成する
2. 「至」リストの入力に応じて、「自」リストの下限を示すセルのアドレスを作成する
3. 上記1.、2.を組み合わせて「自」リスト用の参照範囲アドレスを作成する
4. 上記1.、2.を組み合わせて「至」リスト用の参照範囲アドレスを作成する

以上の四つだ。

今回は

このようにした。

F2セルの数式のみコメントで表示しているが、この場合だと

Ａ２セルの入力値が「至」欄の入力値の上限値になる

ようにしている。

「至」リストは、「自」欄の入力値から（つねに）最大の値（今回の場合は「20」）までを受け付ければよいので、「至」リストの参照アドレスは、

このように先ほどのF2セルの返り値に「":$D$20"」をくっつけてやればよい。

参考までにそれぞれの補助セルについて数式を記しておく。

至リストの先頭行（F2セル）

=IF(A2="","$D$1","$D$"&MATCH(A2,$D$1:$D$20,0))

自リストの先頭行（G2セル）

=IF(B2="","$D$20","$D$"&MATCH(B2,$D$1:$D$20,0))

自リストの参照アドレス（H2セル）

="$D$1:"&G2

至リストの参照アドレス（I2セル）

=F2&":$D$20"

あとは、「自リストの参照アドレス」欄（H2セル）の返り値を「自」欄（A2セル）のリストの「元の値」、「至リストの参照アドレス」欄（I2セル）の返り値を「至」欄（B2セル）のリストの「元の値」

で、それぞれINDIRECT関数の引数にすればよい。

使ってみる

こんな風に動きます。

いい感じではないでしょうか。

おわりに

私は乏しい知識と経験をもとにこのように考えましたが、他にもいろんなやり方があると思います。

ユーザーの入力に縛りをかける、というのはExcel仕事において非常に大切だと思います。

「もっと良いやり方があるぜ！」という方がいらっしゃいましたら、ぜひ教えろ教えてください。

Wordドキュメントに特定のキーワードが含まれているかどうかを判定する(Word)

Wordドキュメントに特定のキーワードが含まれているかどうかを判定する

困ったこと

めちゃくちゃめんどくさい調べ物をして作ったWordドキュメントが、フラッシュメモリから消えていた。

今使っている安物のフラッシュメモリは、変なところで買ったやつで、しばしばフォルダの中身が突然空になるなど、非常におそろしい動作をするので、それかなとも思った。ただ、フォルダの中身が消えているのではなく、フォルダ構成からして変わっているので、どうもBackup用のディスクからフォルダごと上書きしてしまったらしい。

イチから作り直すことも考えたが、あまりにもめんどくさいので、いちかばちか復元を試みることにした。

DiskDiggerによる復元

ずーっと前に、USBフラッシュメモリが突然「フォーマットしますか？」になったときに世話になったDiskDiggerというフリーソフトでWordドキュメントを復元してみた。

そうすると、

この状態……。何十個も検出されたのですよ。

この中から、お目当てのファイルを突き止めるのは、大変である。

幸い、紛失したWordドキュメントの中には、かなり特殊な文言が用いられているので、

ドキュメントに特定のキーワードが含まれているかどうかを判定するFunction

を作ったらよいと考えた。

ドキュメントに特定のキーワードが含まれているかどうかを判定するFunction

手順は至極簡単。

• ドキュメントを開く
• ドキュメントの全文を取得する
• 取得した中にキーワードが含まれているかどうか判定する

たったこれだけ。実に簡単。

ドキュメントを開く

これは、[Documents].Openメソッドを使ったらよい。

ドキュメントの全文を取得する

これは、[Document].Range()とすれば、ドキュメントの本体部分のRangeオブジェクトが返るっぽい。

だから、[Document].Range().Textとしてやれば、全文を取得することができる。

コーディング

上記を踏まえて、Functionを作成する。

リスト１

Public Function HasKeyWord( _
            ByVal TgtDocument As Document, _
            ByVal KeyWord As String) As Boolean
  HasKeyWord = True
  If InStr(1, TgtDocument.Range().Text, KeyWord) > 0 Then Exit Function
  HasKeyWord = False
End Function

たったこれだけ。

使ってみる

まずは、このようなWordドキュメント（笑）を準備する。

このドキュメント（笑）に対して、HasKeyWordメソッドを実行してみる。

イミディエイト・ウィンドウに

?HasKeyWord(ThisDocument,"できる・できないのひみつ")

と入力して[Enter]！

うむ。望み通りの結果を返しておる！

次に、ドキュメント（笑）から「できる・できないのひみつ」を削除し、

この状態にしてから、イミディエイト・ウィンドウに上掲コードを入力して[Enter]！

うむ！　素晴らしい！

最後に、1万字超のドキュメントでもやってみる。

こんなふうに、1万字超のドキュメント内に、こっそり「そんなの、できっこないす！」というキーワード（笑）をしのばせておく。

んで、このドキュメントをアクティブにしておいて、イミディエイト・ウィンドウに

?HasKeyWord(ActiveDocument,"そんなの、できっこないす！")

と入力して[Enter]！

おおおおおお！　バッチリやないかーーーー！

おわりに

……というわけで、このメソッドを用いて、奇跡的に紛失したファイルを無事に見つけ出したのでありました。

めでたしめでたし。