各ページの行数を取得する(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]！

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

おわりに

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

めでたしめでたし。

名簿作成マクロのスタイル(1)

名簿作成マクロのスタイル(1)

Excelで名簿を扱うことが多い私。

これまで数多くの名簿を作成してきたなかで、最近だいぶスタイルが固まってきたので、一旦まとめておくことにした。

この先また考え方が変わるかも知れないが。

シートの役割に関するものはシートモジュールに書く

シートの役割を明確化する

そもそものExcelの使い方に関わる部分。多くの達人の皆さんが共通して〈シートごとに役割をハッキリさせよ〉的なことを述べておられると思う。

シートの役割をハッキリさせると、そのシートが請け負うべき機能もハッキリする。

その機能を実現するコードはそのシートのシートモジュールに書けば良いのだ。

たとえば、名簿作成の元になるデータを入れておくシートが必要だろう。

これは、〈１行１レコード・１列に１データ〉の原則に基づいて作るものだろう。

こんなふうに。

オブジェクト名をつける

私は、このような元データのシートには、

このように、オブジェクト名を「Sh01Data」として、シート名を「Data」とすることが多い。

オブジェクト名は、デフォルトだと「Sheet1」となっているが、このまま使っていると、大規模なプロジェクトでシート数が9を超えたときに、「プロジェクト エクスプローラー」上での並び順がイマイチになる。

このように実にうっとうしい並び順になってしまう。

さすがにシート数が99を超すことはないと思うので、シートモジュールのオブジェクト名は〈Shプラスゼロ埋め2桁〉を接頭辞にして命名するようにしている。

シートモジュールに書くコード

さて、では、このシートのシートモジュールには何を書くか。

このシートの役割は、

VBAにデータを提供する

ことである。それ以上でもそれ以下でもない。

その役割を考えたとき、大切なのは、、

データの位置が指し示しやすいこと

及び、、

データが取り出しやすいこと

であろう。

そのために、元データ用のシートモジュールには、だいたい次のコードを書くことが多い。

• 列番号を表す列挙体
• 表全体（項目ラベル含む）のRangeオブジェクトを返すプロパティ
• 表の正味のデータ部分（項目ラベルを含まない表全体）のRangeオブジェクトを返すプロパティ

こいつら。

実際のコード

先に挙げた

を例に、実際にシートモジュールに書くコードをお目にかけよう。

列番号を表す列挙体

表では、

• 1列目：名前
• 2列目：名前ふりがな
• 3列目：所属
• 4列目：卒業期
• 5列目：級
• 6列目：班
• 7列目：戦法
• 8列目：失格

となっている。

そこで、シートモジュールの宣言セクションに次のように列挙体を定義する。

Public Enum Sh01ColumnName
  sh01Name = 1
  sh01Phonetic
  sh01Prefecture
  sh01Generation
  sh01Grade
  sh01Class
  sh01Style
  sh01Unable
End Enum

ポイントは、列挙体の各要素に「sh01」という接頭辞をつけている点。

名簿作成作業の場合、元データから必要なデータだけを抽出して、表示用の別シートに転記する、という作業が重要になることが多い。

となると、転記先のシートでも同じように列番号を列挙体で定義する、という機会が生ずる。

そうなったときに、接頭辞をつけるようにすれば、同名被りをほとんど気にしなくてもよくなるのだ。

たとえば、Sh02View1というシートオブジェクトの1列目に名前、2列目に所属、3列目に戦法を転記するような場合なら、Sh02View1モジュールには、たとえば

Public Enum Sh02ColumnName
  sh02Name = 1
  sh02Prefecture
  sh02Style
End Enum

という列挙体を定義しておけばよい。

Sh01Dataオブジェクトのsh01Name列目のデータはSh02View1オブジェクトのsh02Name列目に転記するということになり、実にわかりやすい。

表全体（項目ラベル含む）のRangeオブジェクトを返すプロパティ

元データからデータを抽出するときには、[Range].AdvancedFilterメソッドを使うと便利。

[Range].AdvancedFilterメソッドを使う際には、[Range]オブジェクトが項目ラベルを持っていないとダメなので、表全体を手軽に取得できればコードが読みやすくなるだろう。

私は次のようなコードで表全体のRangeオブジェクトをシートオブジェクトのプロパティにして、取得しやすくしている。

Public Property Get WholeList() As Range
  Set WholeList = Me.Range("A1").CurrentRegion
End Property

こうしておくことで、項目ラベルを含む表全体を、

Sh01Data.WholeList

という式で他モジュールから参照することができて便利。

表の正味のデータ部分（項目ラベルを含まない表全体）のRangeオブジェクトを返すプロパティ

項目ラベルを含む表全体とは別に、項目ラベルを除いた表の正味のデータ部分も必要。Rangeオブジェクトの1行目がデータの1行目になるから。

[Range].Valueプロパティの返り値をVariant変数に突っ込んだときにできる2次元配列が1始まりの配列になる挙動とも実に相性がよい。

そこで、次のようなプロパティを別途設定する。

Public Property Get DataList() As Range
  Dim ret As Range
  Set ret = Me.Range("A1").CurrentRegion
  If ret.Rows.Count = 1 Then Exit Property
  With ret
    Set ret = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count)
  End With
  Set DataList = ret
End Property

OffsetプロパティとResizeプロパティを用いて、正味のデータ部分を取り出している。

まあ、元データについてはユーザが触ることは基本ないので、正味の元データ部分に、たとえば「選手データリスト」とでも名前を定義しておいて、

'Declarations Section'
Private Const RACER_DATA_LIST As String = "選手データリスト"

'Properties'
Public Property Get DataList() As Range
  Set DataList = Me.Range(RACER_DATA_LIST)
End Property

で十分だとは思う。もちろん、この場合、表の末尾にデータを追加した場合は範囲の名前定義を修正する必要があるが。

おわりに

シートの列番号と列挙体との相性はきわめてよいので、おすすめです。

つづく……かなあ？？？

「ネオ写経」のすすめ

「ネオ写経」のすすめ

新型コロナウイルス対応で外出の自粛が求められる中、みなさまいかがお過ごしでしょうか。

ろくにテレワーク環境も整っていないのに、「とにかくテレワークだ！」的に導入されてしまった事業所も、それなりにあると思います。

個人的には、この期間は〈終息後のダメージ回復〉を効果的に行うために個人が力量を高める機会ととらえるのが良いと思います。それができる余裕のある業界に限られますが……。

「ネオ写経」とは

私が勝手に考えました。

もともと、プログラミング界隈で「写経」といえば、サンプル・コードの類を写すこと。（ですよね？）

ただ、私は「写経」というものをしたことがほぼない。写しているうちに、「あら？　じゃあ、ここはこうした方がおもろいやんけ。」とか、「ついでにこうしといたれ。」みたいなのが出てくるから、「般若心経」を写していたはずなのに、なぜか「あほだら経」が出来上がっていた、ということが起こる。

そんな私が考えた「ネオ写経」とは！？

既存クラスをラップしたクラスを作る。

これ。

ニセFileSystemObjectを作る

FileSystemObjectは便利だ。

しかも、プロパティ名とかメソッド名は、さすがプロが作っただけあって、実に良くできている。コードが実に読みやすくなる。

ところが、デフォルトでは使えない。

いちいち参照設定をせねばならん。

もちろんCreateObjectを使えば参照設定せずにすむ。

しかし、これだとObject型変数に突っ込んで使用することになり、コーディング時に入力補完の恩恵が得られずイマイチ。

もちろん、コーディング時に参照設定をしておき、完成したら参照設定を切る、という方法もあるにはあるが、それはそれでメンドクサイ。

だったら、FileSystemObjectクラスをラップしたFileSystemObjectクラスを自作しちまえばいいんでねえの！

コンストラクタ

これは簡単。Class_InitializeでScripting.FileSystemObjectクラスのインスタンスを得ればよい。

まず、プロジェクトにクラスモジュールを挿入し、オブジェクト名をFileSystemObjectにする。そして、クラスモジュールに次のコードを書く。

クラスモジュール FileSystemObject

'Declarations Section'
'Module Level Variables'
Private fsObj As Object

'Constructor'
Private Sub Class_Initialize()
  Set fsObj = CreateObject("Scripting.FileSystemObject")
End Sub

これだけ。

これで、プロパティとかメソッドをこの変数fsObjを経由して呼び出すようにすればいい。

プロパティとメソッドの実装（笑）

大袈裟な見出しだが、プロパティをメソッドを実装（笑）するときの教科書が、おれたちの「オブジェクト ブラウザー」様だ！

「ブラウザー」と延ばしているところがボスキャラ感があっていいよね。

[F2]キーを押すか何かして、「オブジェクト ブラウザー」を開き、FileSystemObjectを指定すると、

こんなふうにメンバを確認することができるし、

こんなふうに各メンバの実装方法を確認することもできる。

あとはコーディングあるのみ！

……である！

プロパティの実装（笑）

……といっても、FileSystemObjectにはプロパティは一つしかない。これは意外だった。なんと、Drivesコレクションを返すDrivesプロパティしかないのだ。

実装方法は、オブブラ（略すなｗ）によると、

Property Drives As Drives

とのこと。

もちろん、このまま打ち込んでもコンパイルエラーになるので、脳内でコードを補完して

Public Prooerty Get Drives() As Drives

とする。

もちろん、Microsoft Scripting Runtimeを参照設定しないのだから、As Drivesではまずい。で、

Public Prooerty Get Drives() As Object

と、返り値をObject型に改めておく。

あとは中身。

Dim ret As Object
Set ret = fsObj.Drives    '……(1)'
Set Drives = ret    '……(2)'

これでいい。変数fsObjはモノホンのFileSystemObjectクラスのインスタンスを指しているから、そのDrivesプロパティの返り値はもちろんモノホンのDrivesコレクション。

だから、まずは(1)の

Set ret = fsObj.Drives

で返り値用の変数retにモノホンのDrivesコレクションを突っ込んでおき、(3)の

Set Drives = ret

でニセのDrivesプロパティの返り値としてやる。

プロシージャ全体は

Public Prooerty Get Drives() As Object
  Dim ret As Object
  Set ret = fsObj.Drives
  Set Drives = ret
End Property

こう。

メソッドの実装（笑）

メソッドも基本的にはこの方法。

このように、オブブラ（笑）で、

• Sub／Functionの別
• 引数リスト
• 引数がOptionalかどうか
• 返り値の型

を確認し、それに応じてコーディングすればいい。

たとえば先の画像のCreateTextFileメソッドならば、

• 種別はFunction
• 引数はFileName、OverWrite、Unicodeの三つ。
• 引数OverWrite・UnicodeはOptional
• 返り値はTextStream型

なので、それに応じてコーディングする。

Public Function CreateTextFile( _
	    ByVal FileName As String, _
   Optional ByVal OverWrite As Boolean = True, _
   Optional ByVal Unicode As Boolean = False) As TextStream

となる。

しかし、TextStreamクラスもScripting.FileSystemObjectクラスのメンバなので、Objectにする。

Public Function CreateTextFile( _
	    ByVal FileName As String, _
   Optional ByVal OverWrite As Boolean = True, _
   Optional ByVal Unicode As Boolean = False) As Object

こうなる。

プロシージャ全体は

Public Function CreateTextFile( _
	    ByVal FileName As String, _
   Optional ByVal OverWrite As Boolean = True, _
   Optional ByVal Unicode As Boolean = False) As Object
  Dim ret As Object
  Set ret = fsObj.CreateTextFile(FileName, OverWrite, Unicode)
  Set CreateTextFile = ret
End Function

こう。

引数が列挙体型のやつがある

あと、メソッドの中には引数がScripting.FileSystemObjectの中で定義された列挙体であるものがある。

たとえば、

このGetStandardStreamメソッドの場合、

Function GetStandardStream(StandardStreamType As StandardStreamTypes, [Unicode As Boolean = False]) As TextStream

とあるように、第１引数StandardStreamTypeがStandardStreamTypesという見慣れない型である。

こいつは、オブブラ（笑）で見ると

となっているように、Scriptingクラスで定義された列挙体なんである。

当然、Microsoft Scripting Runtimeを参照設定していないと使えない。

そういうときはどうするか。

このニセFileSystemObjectクラスモジュール内でPublic Enumにしてしまえばいいのである！

'Declarations Section'
'Constants'
Public Enum StandardStreamTypes
  StdIn = 0
  StdOut = 1
  StdErr = 2
End Enum

列挙体のメンバがそれぞれどの数値を表しているのか、というのもオブブラ（笑）先輩を見ればわかる。

ほれ。こんなふうに。

Scripting.__MIDL___MIDL_itf_scrrun_0001_0001_0003ちゅうのは何のことやらわからんがｗ

おわりに

上記のようにして、ひたすらプロパティ・メソッドを実装（笑）し続けることを、「ネオ写経」と呼んでおります。

オブジェクトの仕組みがよくわかって実に勉強になります。

「新型コロナ自粛で勉強ぐらいしかすることがない」という人は、一度やってみてはいかがでしょうか？

ちなみに、FileSystemObjectは、配下にDrives、Drive、Folders、Folder、Files、File、TextStreamというScripting内のオブジェクトを抱えているので、本気でFileSystemObjectクラスを丸ごとラップしようと思ったら、全部で八つもクラスモジュールを作ることになりますｗ

こんなふうに。

特に、Folders-Folderのような階層構造を持つクラスを表現するのにめちゃくちゃ頭を使いましたｗ

FormattedTextプロパティの怪

FormattedTextプロパティの怪

『Writing Word Macros』という本を買った。

FormattedTextプロパティ

Rangeオブジェクトのところを読んでいたら、FormattedTextというプロパティについて書いてあった。

へえ。そんなものがあったのか。

で、『Word 2013 developer docs』（オフラインヘルプ）で調べてみた。

すると、

Returns or sets a Range object that includes the formatted text in the specified range or selection. Read/write.

こんなふうに書いてある。

「FormattedText」という名前だが、Range型らしい。

まあ、書式情報を含んでいないといけないわけだから、String型のわけがないのだが。

実験

んで、ちょいと実験。

おなじみ、

このようなDocument（笑）を準備。

この中で、ゴシック体になっている「月面宙返り」の部分を、このDocument（笑）のケツに挿入するコードを書いてみる。

リスト１

Private Sub testFormattedTextProperty()
  Dim rng As Range
  Set rng = Selection.FormattedText  '……(1)'
  With ActiveDocument
    Call .Range(.Range.End - 1, .Range.End - 1).Select  '……(2)'
    Set Selection.FormattedText = rng  '……(3)'
  End With
End Sub

(1)の

Set rng = Selection.FormattedText

で変数rngにSelectionオブジェクトのFormattedTextプロパティの返り値（Range型）を突っ込む。

あとは

With ActiveDocument
  Call .Range(.Range.End - 1, .Range.End - 1).Select  '……(2)'
  Set Selection.FormattedText = rng  '……(3)'
End With

の(2)でDocument（笑）の末尾位置を選択し（[Range].Endプロパティは、末尾の改段落記号まで含めた数値を返すので、1を引いておかないとカーソル移動ができず、エラーになるので注意。）、(3)でそのFormattedTextプロパティに(1)で取得したRangeオブジェクト（rng）をセットする。

これで盤石である。時は来た。それだけだ！

先のDocument（笑）の「月面宙返り」の部分を

このように選択して、リスト１を実行。

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

なんと、コンパイルエラー……。

「不正」呼ばわりである。

冗談半分で、リスト１の(3)の部分を

Selection.FormattedText = rng

にして実行してみる。

すると、

えっ？！　なんで？？？

やりたかったことが実現できたとはいえ、わけがわからん。

よくわからないこと

オブジェクト ブラウザーによると、

Word.Rangeオブジェクトの既定メンバはTextプロパティである。

ということは、

Selection.FormattedText = rng

というのは

Selection.FormattedText.Text = rng.Text

ということにならないのだろうか。

FormattedTextプロパティがRange型であり、「Read/write」である以上、

Set Selection.FormattedText = rng

でないとおかしいように思うのだが……。

おわりに

ちなみに、たとえばリスト１の(3)のところを

Selection.FormattedText.Text = rng

にして実行すると、

このようにわけのわからない結果になる。

また、そもそもはコーディング・ミスだったのだが、リスト１の(3)を

Selection.FormattedText = rng.FormattedText

としても、

このように正しい（？）結果になる。

また、リスト１の(3)を

Selection.FormattedText = rng.Text

にすると、

「型が一致しません」というコンパイルエラーになる。

左辺と右辺をあれこれ変えてみた結果をまとめたのが

これ。

わからぬ……。

Tableオブジェクトの怪(Word)

Tableオブジェクトの怪(Word)

実に気色悪い現象に出くわしたので報告。

表の余分な行を削除する

たとえば、Wordでドキュメント内の表にデータを差し込むようなとき、

このように、使用しない行が生ずることがある。

宛先によってデータの数が異なるとき、テキトーな上司なら「ま、別にええんちゃう？」で済むのだが、神経質な上司だったりすると、「空白行は消さんかい！」などということに。

そこで、マクロで空白行を削除することを企てるのである。

マクロで空白行を削除する

次のようなコードで、空白行の削除を試みる。

リスト１

Private Sub test03()
  Dim tbl As Table
  Set tbl = ActiveDocument.Tables(1)  '……(1)'
  Dim i As Long
  With tbl    '……(2)'
    For i = .Rows.Count To 2 Step -1  '……(3)'
      If .Cell(i, 1).Range.Text = Chr(13) & Chr(7) Then  '……(4)'
        Call .Rows(i).Delete
      Else
        Exit For
      End If
    Next
  End With
End Sub

まず、(1)の

Set tbl = ActiveDocument.Tables(1)

で対象の表（Tableオブジェクト）を変数tblにぶち込む。

(2)の

With tbl

で記述をまとめておいて、(3)の

For i = .Rows.Count To 2 Step -1
  If .Cell(i, 1).Range.Text = Chr(13) & Chr(7) Then  '……(4)'
    Call .Rows(i).Delete
  Else
    Exit For
  End If
Next

のForループ。

「削除するときはケツから！」の原則に基づいて、TableオブジェクトのRowsコレクションのCountプロパティの値、すなわち表の行数からスタートして、2行目まで繰り返すことにする。

ループ内では、(4)の

If .Cell(i, 1).Range.Text = Chr(13) & Chr(7) Then

で、１列目に文字が入っているかどうかを判定。

Wordの表では、文字の入っていないセルにはChr(13)とChr(13)が入っている。

akashi-keirin.hatenablog.com

セル内に文字が入っていなければ

Call .Rows(i).Delete

で行ごと削除。

セル内に文字が入っていれば、（上の行から順にデータを入れている以上）これ以上削除する行はないと言うことだからElseブロックに進んで

Exit For

でループを抜ける。

実行

これで基本的にはうまいこと行くはずである。

しかし、ループに突入し、一つ目（つまり、5行目）を削除した途端、

工工工ｴｴｴｴｴｴｪｪｪｪｪｪ(ﾟДﾟ)ｪｪｪｪｪｪｴｴｴｴｴｴ工工工

何故、何故なんだ～？！

突然表の横幅がビニョーーーーンと伸びてしもたやないか……。

[Table].ColumnsコレクションからColumnオブジェクトを取得してWidthプロパティを調べてみる。

上が無残にも横に引き延ばされてしまったTables(1)、下があらかじめ同じものをコピッペしておいたTables(2)である。

このように、全然違うサイズに変わり果ててしまっていることがわかる。

おわりに

さっぱりわけがわからん。

何故、何故なんだ～？！（２回目。）