Wordの「スタイル」をVBAで操作する(2) (Word)
「標準」スタイルのフォントを変える
前回
のつづき。
ウチの環境では、Document.Styles(194)で「標準」スタイルにアクセスできるのだった。
Style.Fontオブジェクト
MSDN Dev Centerの「Style Members (Word)」によると、フォントの設定はFontプロパティにアクセスしてFontオブジェクトを取得して操作するっぽい。
で、Fontオブジェクトのページ（MSDN Dev Centerの「Font Members (Word)」）を見てみると、フォント名を設定／取得するっぽいものとして
NameNameAsciiNameBiNameFarEastNameOther
この５種があった。
詳しくはリンク先の記載内容をお読みいただくとして、基本的にはNameプロパティ（英数字用）、NameFarEastプロパティ（日本語用）を設定すればいいっぽい。
イミディエイト・ウィンドウで確認する
イミディエイト・ウィンドウに、
?thisdocument.Styles(194).Font.NameFarEast
および、
?thisdocument.Styles(194).Font.Name
と入力して確認してみる。
この通り、NameFarEastの方は「ＭＳ 明朝」、Nameの方は「Century」が返った。
Word本体の方に戻って、スタイル ギャラリーで確認してみると、
ぴったり一致している。
つまり、Document.Style.Font.NameFarEastで日本語用フォント、Document.Style.Font.Nameで英数字用フォントを設定することができるということだ。
「標準」スタイルのフォント設定をVBAで変えてみる
イミディエイト・ウィンドウに
thisdocument.Styles(194).Font.NameFarEast = "ＭＳ ゴシック"
と入力して[Enter]してみる。
意図どおりの結果になっている。
これで面倒だった作業が１クリックでできるめどが立った。
Wordの「スタイル」をVBAで操作する(Word)
Wordの「スタイル」をVBAで操作する
ウチの職場には、書類の英数字は等幅という謎ルールがある。
まあ、位置が揃わないのが嫌なのはなんとなく分かる。
ただ、「スタイル」という機能を知らずにWordを使っている人がほとんど（目測で９割以上）なので、
文書作成→文書全体を選択→フォントを「ＭＳ 明朝」に変更
という
最高にロックなイカしたやり方
をする人がほとんど。
っていうか、ドヤ顔で
最後に全体を選択して「ＭＳ 明朝」に変えたら楽やないか！
と推奨する人までいる（実話）。
そんなわけで、ウチで量産されるWord文書は、「標準」スタイルの英数字フォントの設定がデフォルトの「Century」のままなのに、英数字の箇所はことごとく「ＭＳ 明朝（またはゴシック）」という最高にクールなことになっているのである。
スタイルを変更するのはめんどくさい
書類なんかは、前年度のものを使い回すことが多いので、当然「標準スタイル」の英数字フォントがCenturyのままなのに、英数字のところが「ＭＳ 明朝」に無理矢理変えられているだけの文書を扱う機会が多い。っていうか、ほぼそんな感じ。
したがって、「標準」スタイルのフォント設定を変更するという作業が発生するのだが、正攻法でやると結構めんどくさい。
「標準」スタイルの英数字フォント設定を変更する手順
- 「ホーム」タブの「スタイル ギャラリー」で「標準」を右クリック
- 「変更」をクリック
- 「書式」ボタンをクリック
- 「フォント」をクリック
- 「フォント」タブの「英数字用のフォント」のドロップダウンリストから「（日本語用と同じフォント）」を選択
- [ＯＫ]をクリック
- [ＯＫ]をクリック
と、実に７段階もの作業が生ずるのである！
こういう単純作業はマクロ化するに限る。
Document.Styleオブジェクト
ちょいと調べてみると、「スタイル」そのものは、Documentオブジェクトの配下にあるStylesコレクションの一員で、Styles（Index）で取得できるということはすぐに分かった。
【参考】MSDN デベロッパー センター「Styles オブジェクト (Word)」
Styleオブジェクトのメンバについては、MSDN デベロッパー センター「Style Members (Word)」に掲載されているが、英語版しかないみたい。
「標準」スタイルのインデックス番号を割り出す
オブジェクト ブラウザーで、Styleオブジェクトのメンバを列挙してみる。
どうもNameLocalというやつがスタイルの日本語名を指すっぽい（なんでコイツだけ変なアイコンなんだろ？）。
MSDN デベロッパー センター「Style Members (Word)」での説明も、
Returns the name of a built-in style in the language of the user. Read/write
String.
となっている。「ユーザーの言語での組み込みスタイル名を返す」ぐらいか。
で、次のコードで「標準スタイル」のインデックス番号を割り出すことを試みた。
リスト１ 標準モジュール
Public Sub test()
Dim s As Style
Dim cnt As Long
cnt = 1
For Each s In ThisDocument.Styles
Debug.Print cnt & vbTab & s.NameLocal
cnt = cnt + 1
Next
End Sub
For EachでStylesコレクションを巡回して、1から順に番号を付けてスタイル名をイミディエイトに表示するだけのコード。
別にFor Eachじゃなくても、普通のFor文でも書ける（For i = 1 To ThisDocument.Styles.Countにする）。
[F8]連打でステップ実行を繰り返すと、
発見！
ウチの環境では、「194」というのが「標準」スタイルのインデックス番号らしい。
Document.Styles(194)で「標準」スタイルオブジェクトにアクセスできるので、あとはオブジェクトの操作の仕方さえ分かったらマクロ化が可能になる。
VirtualTableクラスへのメソッドの追加[getFilteredArrayメソッド]
VirtualTableクラス続報
指定した条件を満たす配列を返すメソッド
任意の列の値が指定した値であるレコードだけを格納した配列を返すメソッドを作ってみた。
ひとまずコードを載っけておく。
getFilteredArrayメソッドのコード
リスト1-1 クラスモジュール
'///２次元配列（引数１）から任意の列（引数２）の値が、任意の値（引数３）である'
' 要素だけを抽出した２次元配列を返す'
Public Function getFilteredArray( _
ByRef targetArray As Variant, _
ByVal targetColumn As Long, _
ByVal targetValue As Variant) As Variant '……(1)'
'///ガード節。未初期化ならエラーを吐く。'
If Not isInitialized_ Then _
Call catchException(thrownException10001) '……(2)'
'///ガード節。引数１が２次元配列でなかったらエラーを吐く。'
If getArrayDimension(targetArray) <> 2 _
Then Call catchException(thrownException10002) '……(3)'
On Error GoTo errorHandler
Dim returnArray As Variant '……(4)'
ReDim returnArray(1 To 1, 1 To UBound(targetArray, 2))
Dim i As Long
Dim j As Long
Dim n As Long '……(5)'
n = 1
For i = LBound(targetArray, 1) To UBound(targetArray, 1) '……(6)'
If targetArray(i, targetColumn) = targetValue Then
'２要素目以降は、配列を拡張してから要素を追加する'
If n > 1 Then returnArray = _
expand2DimentionalArray(returnArray, 1) '……(7)'
For j = LBound(targetArray, 2) To UBound(targetArray, 2) '……(8)'
'各列の要素を追加'
returnArray(n, j) = targetArray(i, j)
Next
n = n + 1 '……(9)'
End If
Next
isFiltered_ = True
filteredArray_ = returnArray '……(10)'
getFilteredArray = returnArray: Exit Function
errorHandler:
'///配列の作成に失敗してエラーが出たら、既存のfilteredArray_を返す'
getFilteredArray = filteredArray_
End Function
まずは(1)の
Public Function getFilteredArray( _
ByRef targetArray As Variant, _
ByVal targetColumn As Long, _
ByVal targetValue As Variant) As Variant
で引数と返り値の設定。
冒頭のコメントにもあるように、
第１引数targetArrayが元になる配列、
第２引数targetColumnが抽出条件となる列、
第３引数targetValueが抽出条件となる値である。
返り値は配列なんだけれども、As Variant()とするといろいろ面倒なので、単にAs Variantとした。
(2)と(3)の
If Not isInitialized_ Then Call catchException(thrownException10001) If getArrayDimension(targetArray) <> 2 Then Call catchException(thrownException10002)
はコード内のコメントにもあるようにガード節。VirtualTableクラスのインスタンスのinitメソッドが未実行だったり、第１引数targetArrayが２次元配列でなかった場合にはエラーを吐くようにしている。コード内のcatchExceptionとかgetArrayDimensionというのは、クラス内で定義しているローカルメソッド。前者はエラーを吐くためのもの、後者は配列の次元数を返すもので、後者については、後のリスト1-2で紹介する。
で、(4)からがメソッドの本体。
(4)からの２行
Dim returnArray As Variant ReDim returnArray(1 To 1, 1 To UBound(targetArray, 2))
で、抽出後の配列を格納する変数を準備する。
宣言後、即とりあえず１次元目の要素数を「1」、２次元目の要素数を元の配列と同じ数にしてReDimしておく。
(5)からの２行
Dim n As Long n = 1
では、Long型の変数 n を準備し、「1」で初期化。
これは、抽出後の配列の１次元目のインデックスとして用いる。
(6)からの10行（コメント除く。実質９行）
For i = LBound(targetArray, 1) To UBound(targetArray, 1)
If targetArray(i, targetColumn) = targetValue Then
If n > 1 Then returnArray = _
expand2DimentionalArray(returnArray, 1) '……(7)'
For j = LBound(targetArray, 2) To UBound(targetArray, 2) '……(8)'
'各列の要素を追加'
returnArray(n, j) = targetArray(i, j)
Next
n = n + 1 '……(9)'
End If
Next
では、元の配列をループして条件に合致するかどうかを判定、条件に合致した行のデータをreturnArrayに格納している。
元の配列のtargetColumn列目のデータがtargetValueと一致していたら条件に合致したということ。
その場合は、(7)の
If n > 1 Then returnArray = _
expand2DimentionalArray(returnArray, 1)
でnが２以上になっていると、その都度expand2DimentionalArrayメソッドを用いて配列の１次元目の上限を１だけ拡張する。
expand2DimentionalArrayメソッドもクラス内のローカルメソッド。こちらは後のリスト1-3で紹介する。
配列の拡張ができたら、(8)からの３行（コメント除く）
For j = LBound(targetArray, 2) To UBound(targetArray, 2) returnArray(n, j) = targetArray(i, j) Next
で元の表のi行目の各列の値を、returnArrayのn行目各列に格納する。
あとは、(9)の
n = n + 1
でnをインクリメントする。
あとは、(10)の
filteredArray_ = returnArray getFilteredArray = returnArray: Exit Function
で、クラス内のPrivate変数filteredArray_に抽出後の配列returnArrayをコピーした上でreturnArrayを返しておしまい。
お次に、このメソッド内から呼ばれるPriveteメソッドを紹介する。
リスト1-2 クラスモジュール
Private Function getArrayDimension( _
ByRef targetArray As Variant) As Long
If Not IsArray(targetArray) _
Then getArrayDimension = False: Exit Function
Dim n As Long
n = 0
Dim tmp As Long
On Error Resume Next
Do While Err.Number = 0
n = n + 1
tmp = UBound(targetArray, n)
Loop
Err.Clear
getArrayDimension = n - 1
End Function
これは、
このときに紹介したもの。それをそのまま使っている。
エラーが出ることを利用している、というのは余り健全ではないのかもしれないが、他に方法が思いつかない。
リスト1-3 クラスモジュール
Private Function expand2DimentionalArray( _
ByRef targetArray As Variant, _
ByVal addRows As Long) As Variant()
Dim returnArray As Variant
ReDim returnArray(LBound(targetArray, 1) To _
UBound(targetArray, 1) + addRows, _
LBound(targetArray, 2) To _
UBound(targetArray, 2))
Dim maxRowIndex As Long
If addRows >= 0 Then
maxRowIndex = UBound(targetArray, 1)
Else
maxRowIndex = UBound(returnArray, 1)
End If
Dim maxColumnIndex As Long
maxColumnIndex = UBound(targetArray, 2)
Dim i As Long
Dim j As Long
For i = LBound(targetArray, 1) To maxRowIndex
For j = LBound(targetArray, 2) To maxColumnIndex
returnArray(i, j) = targetArray(i, j)
Next
Next
expand2DimentionalArray = returnArray
End Function
説明がメンドクサイので説明は省略する。
第１引数targetArrayで元の配列、第２引数addRowsで１次元目の拡張数を受け取って、元の配列の１時限目の要素数をaddRows個だけ拡張した配列を返す、というもの。
いちおう、addRowsで負の数が渡されても良いようにはしてある（テスト不足なので、こんなに強気に言い切っていいのかどうかは不明）。
使ってみる
ワークシートにこんな表を用意しておく。
で、次のコードで実験。
リスト２ 標準モジュール
Public Sub testNewVirtualTable()
Dim virtualTable_ As New VirtualTable
With virtualTable_
Call .init(Sheet1.Range("A1").CurrentRegion)
Call .getFilteredArray(targetArray:=.tableArray, _
targetColumn:=3, _
targetValue:="千葉県") '……(1)'
Dim tmpArray As Variant
tmpArray = .filteredArray '……(2)'
Dim i As Long
For i = LBound(tmpArray, 1) To UBound(tmpArray, 1) '……(3)'
Debug.Print tmpArray(i, 1)
Next
End With
Set virtualTable_ = Nothing
End Sub
VirtualTableクラスのインスタンスを生成し、initメソッドで表を２次元配列として格納したら、(1)の
Call .getFilteredArray(targetArray:=.tableArray, _
targetColumn:=3, _
targetValue:="千葉県")
でgetFilteredArrayを実行する。
第１引数のtableArrayというのは、VirtualTableクラスのプロパティで、initメソッドで渡した配列を返す、と思ったら良い。
第２引数targetColumnに「3」、第３引数targetValueに「千葉県」を渡しているので、元の表のＣ列が「千葉県」になっているレコードだけを抽出して格納した２次元配列が作成されることになる。
(2)の
tmpArray = .filteredArray
は、変数tmpArrayにvirtualTable_.filteredArrayを代入する形になっている。
filteredArrayというのも、VirtualTableクラスのプロパティで、getFilteredArrayメソッドの実行によって作成された配列が返るようになっている。
そもそもgetFilteredArrayメソッドがFunctionなので、ここは
tmpArray = .getFilteredArray(targetArray:=.tableArray, _
targetColumn:=3, _
targetValue:="千葉県")
と書いても良かったところ。
あとは、(3)の
For i = LBound(tmpArray, 1) To UBound(tmpArray, 1) Debug.Print tmpArray(i, 1) Next
で、抽出されてできた配列の１列目をイミディエイトに出力させるようにした。
実行結果
こんなふうに表示された。
元の表をフィルターで抽出してみると、
この通り。意図どおりの結果となっていた。
おわりに
すでに、複数条件に対応したメソッドも作成済みです。
Worksheet_Changeイベントの引数Target(Excel)
Worksheet_Changeイベントの引数Target
Worksheet_Changeイベントについては、イベントを起こすセル範囲を限定するのによく使う。
引数「Target」に関する注意事項
Worksheet_Changeイベントが発生したときに、プロシージャに渡される引数Targetについて、ちょっと気をつけておいた方が良いことに気づいたので、備忘録的に記しておく。
まず、Worksheet_Changeのイベントプロシージャとして、次のコードを書いておく。
Private Sub Worksheet_Change(ByVal Target As Range) Debug.Print "引数TargetのCountプロパティ：" & Target.Count End Sub
引数TargetのCountプロパティをイミディエイト・ウインドウに表示するだけのプロシージャ。
フィルハンドルでドラッグしたとき
こんなふうに、ドラッグしてコピーしたときの引数Targetは、
これでお分かりのように、ドラッグした範囲全てである。
行ごと削除した場合
こんなふうに、行を丸ごと選択して、削除する。
147456!!!!!!!!
すさまじい数のRangeオブジェクトが渡されている。
行ごと／列ごと削除の場合に何もせずにExitする
Targetの中身を調べて、その中身次第でイベントプロシージャの処理を実行するかどうかを分岐したいとき、列ごと削除や行ごと削除された日には、すさまじい回数の計算が生ずることになる。かといって、通常の操作におけるセルの上限個数なんて決められない場合がある。
たとえば、フィルハンドルで値をコピーしたときにはそれぞれのセルの値に応じて処理をしたい、というようなとき、ドラッグする範囲の上限なんて決められない。そんなときに、【列ごと削除した】とか【行ごと削除した】ようなときにはイベント処理をしない、というふうにできれば良い。
次のようなコードを考えた。
リスト１
With Target
If .Count Mod Rows.Count = 0 Or _
.Count Mod Columns.Count = 0 Then Exit Sub
End With
こいつをWorksheet_Changeプロシージャの先頭に入れる。
要するに、TargetのCountプロパティがRows.CountとかColumns.Countで割り切れる場合は、行ごと／列ごと変化したとみなして処理を飛ばすわけだ。
行ごと削除してみると、TargetのCountプロパティが98304になっていることが分かる。
Columns.Countの値（１行あたりのセルの総数）は16384。
ご覧のように、98304は16384で割り切れるので、何もせずにExitすることになる。
おわりに
Targetに複数のセルが渡されたときは、Target.Valueとか書いているとエラーになるので、注意が必要。
追記
よく考えたら、
TargetのCountプロパティがRows.CountとかColumns.Countで割り切れる場合は、行ごと／列ごと変化したとみなして処理を飛ばす
というのは余りにも乱暴なやり方だった。
値を書き換えたセル範囲のセルの数（Countプロパティ）がたまたまRows.CountとかColumns.Countの倍数だったりすると、行・列削除だとみなされてしまうことになる（まあ、そんなことは滅多にないだろうけれど）。
それはいくらなんでも、いくらなんでもそれはご勘弁願いたい。というわけで、コードを書き換えてみた。
っていうか、ついでにセル範囲が行または列全体かどうかを判定するFunctionを作ってみた。
リスト１改
Public Function isWholeRowORColumn(ByVal targetRange As Range) As Boolean
With targetRange
If .Rows.Count = Rows.Count Or _
.Columns.Count = Columns.Count Then _
isWholeRowORColumn = True: Exit Function
End With
isWholeRowORColumn = False
End Function
引数で渡されたセル範囲targetRangeの縦幅（targetRange.Rows.Count）がシート全体の縦幅（Rows.Count）と等しかったら列全体、targetRangeの横幅（targetRange.Columns.Count）がシート全体の横幅（Columns.Count）と等しかったら行全体が変化したとみなす。
問題は、列全体または行全体に値が書き込まれた場合だな……。
ExcelVBAでWordドキュメントを軽量PDF化する
ExcelでWordドキュメントを軽量PDF化する
ExcelでWordドキュメントのファイル名の一覧表を作って、必要なものだけPDF化する、というのがお題。
ExportAsFixedFormatメソッドを使うやつは既に作成済みなので、PDF化部分を差し替えるのが目標。
ドキュメントを軽量PDF化するメソッド
ひとまず、コードだけ載っけておこう。
テストが不十分なので、ご利用の際は自己責任でどうぞ。
リスト１ 標準モジュール
Public Function convertDocumentToLightPDF( _
ByVal targetDocument As Word.Document, _
Optional ByVal PDFPrinter As String, _
Optional ByVal printRange As WdPrintOutRange = wdPrintAllDocument, _
Optional ByVal printFrom As Long, _
Optional ByVal printTo As Long, _
Optional ByVal printPages As String) As Boolean
On Error GoTo errorHandler
Dim wordApp As Word.Application
Set wordApp = targetDocument.Parent
If PDFPrinter = "" Then PDFPrinter = wordApp.ActivePrinter
If InStr(PDFPrinter, "PDF") < 1 Then _
convertDocumentToLightPDF = False: Exit Function
Dim currentPrinter As String
currentPrinter = wordApp.ActivePrinter
wordApp.ActivePrinter = PDFPrinter
If printRange = wdPrintFromTo And _
printFrom * printTo = 0 Then
printFrom = 1
printTo = 1
End If
If printRange = wdPrintRangeOfPages And _
printPages = "" Then
printPages = "1"
End If
If Not wrappedPrintOutMethod( _
targetDocument:=targetDocument, _
printRange:=printRange, _
printFrom:=printFrom, _
printTo:=printTo, _
printPages:=printPages) Then GoTo errorHandler
DoEvents
convertDocumentToLightPDF = True
errorHandler:
If Err.Number > 0 Then Err.Clear
wordApp.ActivePrinter = currentPrinter
Set wordApp = Nothing
If Not convertDocumentToLightPDF Then _
convertDocumentToLightPDF = False
End Function
Public Function wrappedPrintOutMethod( _
ByVal targetDocument As Word.Document, _
ByVal printRange As WdPrintOutRange, _
ByVal printFrom As Long, _
ByVal printTo As Long, _
ByVal printPages As String) As Boolean
With targetDocument
If printRange = wdPrintAllDocument Or _
printRange = wdPrintCurrentPage Or _
printRange = wdPrintSelection Then _
Call .PrintOut(Range:=printRange): GoTo Finalizer
If printRange = wdPrintFromTo Then _
Call .PrintOut(Range:=printRange, _
From:=printFrom, _
To:=printTo): GoTo Finalizer
If printRange = wdPrintRangeOfPages Then _
Call .PrintOut(Range:=printRange, _
Pages:=printPages): GoTo Finalizer
End With
errorHandler:
Err.Clear
wrappedPrintOutMethod = False: Exit Function
Finalizer:
wrappedPrintOutMethod = True
End Function
Boolean型のメソッドにした。途中でエラーが出たりしたら、Falseを返す。
あと、渡された引数に合わせてWord.Document.PrintOutメソッドを呼び出す分岐がめんどくさかったので、別途Word.Document.PrintOutメソッドをラップしたメソッドを作った。
２つ目のwrappedPrintOutMethodがそれ。
Word.Document.PrintOutは結構引数が多く、引数チェックが煩雑になるので、メインの方では致命的な不正引数だけチェックして、後はサブのメソッドの方で印刷範囲別（引数「Range」の値別）に対応することにした。
実行結果
Xドライブに「中野 浩一.docx」というドキュメントを置いて、次のコードで実験。
リスト２ 標準モジュール
Public Sub testConvertDocumentToLightPDF()
Dim wordApp As New Word.Application
Dim targetDoc As Word.Document
Set targetDoc = wordApp.Documents.Open("X:中野 浩一.docx")
Call convertDocumentToLightPDF(targetDoc, PDF_PRINTER)
Set wordApp = Nothing
Set targetDoc = Nothing
End Sub
途中「PDF_PRINTER」とあるのは、ウチの環境での「JUST PDF 3」のプリンタ名が入った定数。ちなみに、JUST PDF 3 on Ne03:という文字列が当てられている。
JUST PDF 3 側の設定で、黙って指定済みのフォルダに保存するようにしているので、実行するといつの間にか
こんな風にPDFができている。
画像ではPDFが２つできているが、上がconvertDocumentToLightPDFメソッドで作成したもの。
下は、
Wordの「名前を付けて保存」でPDF化したもの。
「最小サイズ」を指定しても48キロバイトもある。それに比べてconvertDocumentToLightPDFメソッドで作成した方は27キロバイト。
なかなか優秀といえるのではなかろうか。
おわりに
ちなみに、元のドキュメントは16キロバイトである。
プリンタ名を調べる
プリンタ名を取得する
コチラをうｐしたところ、Twitterで次のサイト（『パソコンの小技・備忘録（ExcelのVBAで、パソコンのプリンタ一覧を取得したい。）』）をご紹介いただいた。
たぶん、
プリンタ名を比較するときにApplication.ActivePrinterの返り値をそのまま使うことができないのだ。
そんなわけで、仕方なく純粋なプリンタ名だけをまず切り出して、比較しているのだ。
のところを見て、教えてくださったのだろう。
サンプルコードに学ぶ
前掲サイトに掲載されているコードは
'変数の定義'
Dim tempShell As Object
Dim tempObj As Object
Dim intRow As Integer
'オブジェクトの設定と繰り返し処理'
Set tempShell = CreateObject("Shell.Application") '……(1)'
intRow = 1
For Each tempObj In tempShell.NameSpace(4).Items '……(2)'
If intRow > 1 Then
'取得したプリンタ名をセルに書き込む'
Cells(intRow, 1) = tempObj.Name
End If
intRow = intRow + 1
Next
Set tempShell = Nothing
こんなの。
そういえば、「Shell」とか、今ひとつよく分かっていなかったので、この機会にちょっと調べてみた。
Shellオブジェクト
まず、(1)の
Set tempShell = CreateObject("Shell.Application")
では、Shell.Applicationというクラスのインスタンスを生成して変数tempShellにぶち込んでいる。
Windows Dev Centerの「Shell Object」の項には、
Represents the objects in the Shell. Methods are provided to control the Shell and to execute commands within the Shell. There are also methods to obtain other Shell-related objects.
とあるので、「Shell」というものの中にあるオブジェクトを操れるようにするオブジェクトぐらいの意味なのだろう（適当）。
(2)の
For Each tempObj In tempShell.NameSpace(4).Items
からは、おなじみFor Eachを用いて、[Shellオブジェクト].NameSpace(4).Itemsコレクションの要素を１つ１つ取り出す処理であることが読み取れる。
結局、tempObjという変数には何が入ることになるのか、ちょっと面倒だけれど、せっかくなので丁寧にたどってみる。
まず、ShellオブジェクトのNameSpaceメソッド。
Windows Dev Centerの「Shell NameSpace method」の項によると、
Creates and returns a Folder object for the specified folder.
とある。特殊フォルダの「Folder」オブジェクトを生成したり取得したりするメソッドっぽい（適当）。
ちなみに、上掲コードでは
tempShell.NameSpace(4)
と、NameSpaceメソッドの引数に「4」を渡している。
先ほどの「Shell NameSpace method」の項のVB用のサンプルコードを見ると、
Set objFolder = objShell.NameSpace(ssfPERSONAL)
と、引数のところに「ssf」で始まる定数が使われている。
これは、「ShellSpecialFolderConstants」という組み込み列挙体らしい。
VBEでも、参照設定で「Microsoft Shell Controls And Automation」にチェックを入れて、オブジェクト・ブラウザーを見ると、
こんなふうに表示される。
「4」というのは、「ssfPRINTERS」のことだと分かる。
ちなみに、Windows Dev Centerの「ShellSpecialFolderConstants enumeration」の項によると、「ssfPRINTERS」というのは、
0x04 (4). Virtual folder that contains installed printers.
ということらしい。「Virtual folder」というのがよく分からんが、インストールされたプリンタを管理しているフォルダなんだろう（適当）。
tempShell.NameSpace(4)という式で、めでたくFolderオブジェクトが取得できるので、今度は、tempShell.NameSpace(4).ItemsでFolderオブジェクトのItemsメソッドを使う。
Windows Dev Centerの「Folder object」の項によると、「Items」メソッドというのは、
Retrieves a FolderItems object that represents the collection of items in the folder.
とある。
FolderItemsオブジェクトというのを返すみたい（適当）。
FolderItemsオブジェクトというのはFolderItemオブジェクトのコレクションなので、For Eachで取り出されるのはFolderItemオブジェクトということになる。
Windows Dev Centerの「FolderItem object」の項を見れば、メンバが分かる。
ちゃんとNameプロパティもある。
上掲コード中、For Eachブロック内の
If intRow > 1 Then
という条件分岐がイマイチ意味がよく分からないが、全体として
プリンタ情報を管理している特殊フォルダの中身を一つ一つチェックして、Nameプロパティをセルに書き出す
というコードになっていることが分かる。
実行結果
上掲サンプルコードにテキトーなプロシージャ名を付けて実行すると、
このとおり。
なるほど、純粋なプリンタ名が取得できている。
ただし、これを
このときの軽量PDF出力メソッドにどう生かすか、となると、ちょっとめんどくさそう。
参考
コチラもどうぞ！
ワークシートの軽量PDF化(Excel)
アクティブシートのPDF化
このときにも書いたように、アクティブシートをPDF化するときにはWorksheet.ExportAsFixedFormatメソッドを使う。
ただ、この場合、やたらファイルサイズがデカくなってしまうのが悩みのタネだった。かといって、いちいちJUST PDFなんかを使ってPDF化するのは死ぬほどダルいので、仕方がないなあと思っていた。
ところが、ひょんなことから、VBAでプリンタを指定できると知り、ちょっとやってみた。
Application.ActivePrinterプロパティ
Application.ActivePrinterプロパティというものを使えば、カンタンにプリンタを切り替えることができる。
まず、イミディエイト・ウインドウで現在のApplication.ActivePrinterプロパティを調べてみる。
イミディエイト・ウインドウに、
?Application.ActivePrinter
と入力して[Enter]。
自宅の環境では、
Canon MP470 series Printer on Ne06:
が返った。
んで、Excelの「ファイル」タブから「印刷」メニューを選び、「プリンター」で「JUST PDF 3」を選んでから、再度イミディエイト・ウインドウに
?Application.ActivePrinter
と入力して[Enter]してみると、今度は
JUST PDF 3 on Ne03:
が返っている。
このことを踏まえて、コーディングしてみた。
軽量PDFを出力するメソッド
リスト１ 標準モジュール宣言セクション
Private Const MAIN_PRINTER As String = "Canon MP470 series Printer on Ne06:" Private Const PDF_PRINTER As String = "JUST PDF 3 on Ne03:"
まず、プリンタ名を定数にしておく。これはあくまでもウチの環境のもの。環境が変わったら、その環境でのプリンタ名を調べて、定数を書き換えたらよい。
リスト２ 標準モジュール
Public Sub convertActiveSheetToLightPDF()
Dim Sh As Worksheet
Set Sh = ActiveSheet
With Application
Dim tmp As String '……(1)'
tmp = .ActivePrinter
Dim printerNameLength As Long
printerNameLength = InStrRev(tmp, " on ") - 1
tmp = Left(tmp, printerNameLength)
If tmp <> Left(PDF_PRINTER, printerNameLength) Then '……(2)'
.ActivePrinter = PDF_PRINTER
Sh.PrintOut
.ActivePrinter = MAIN_PRINTER
Else
Sh.PrintOut
End If
End With
End Sub
まず、(1)からの５行
Dim tmp As String '……(1)' tmp = .ActivePrinter Dim printerNameLength As Long printerNameLength = InStrRev(tmp, " on ") - 1 '……(*)' tmp = Left(tmp, printerNameLength)
で、変数tmpに、ポートを除いたプリンタ名を格納している。
ポートは、「on ……」の形で表されるので、前後の半角スペースを含めた「 on 」で後ろから検索したら〈プリンタ名＋１文字〉目が返るので、返り値から１を引いた数をプリンタ名の文字数として変数printerNameLengthに格納する。
あとは、Left関数で切り出しているだけ。
なぜこんなことをするのか。
実は、Application.ActivePrinterの返り値では、ポートの所が「Ne0X:」となっているんだが、ネットワーク上のプリンタの場合、ポートの所を「Ne0X:」で指定するとエラーになる（プリンタのIPアドレスで指定しないとダメ。「JUST PDF 3」の場合だと、「on JUST PDF 3 Port:」と指定する）。
しかも、ウチみたいにプリンタをジカで接続している場合は、逆にポートを「Ne0X:」で指定しないとエラーになるんである（たとえば、「Canon MP470 series Printer on Ne06:」を「Canon MP470 series Printer on USB001:」にするとエラーになる）。
従って、プリンタ名を比較するときにApplication.ActivePrinterの返り値をそのまま使うことができないのだ。
そんなわけで、仕方なく純粋なプリンタ名だけをまず切り出して、比較しているのだ。
あとは、(2)以下の７行
If tmp <> Left(PDF_PRINTER, printerNameLength) Then .ActivePrinter = PDF_PRINTER Sh.PrintOut .ActivePrinter = MAIN_PRINTER Else Sh.PrintOut End If
でメインの処理を行う。
プリンタがJUST PDF 3でなかったら、一旦プリンタをJUST PDF 3に切り替えてからプリントアウトし、メインのMP470に戻す。
もともとプリンタがJUST PDF 3になっているのなら、単純にプリントアウトするだけ。
使ってみる
こんなシートを準備して実行する。
ただし、JUST PDF 3の設定がデフォルトのままだと、保存先を指定したり、ファイル名を指定したりせにゃんらんわ、PDF化後、PDFファイルが開いてしまうわ、といろいろめんどくさいので、コントロールパネルのプリンタの設定のところへ行って、
こんなふうに設定しておくとよい（「保存先」は、好きなところを指定したらよい）。
これで黙って指定したフォルダにPDFを保存してくれる。
フォルダ内の「test.pdf」というのが、できあがったPDF。ファイルサイズは15KB。もう一つの「hoge.pdf」というのが、同じシートをWorksheet.ExportAsFidxedFormatメソッドでPDF化したもの。38KBもある。
おわりに
Application.ActivePrinterプロパティの指定の仕方（プリンタのポートの所）なんかがまだよく分からないのだが、まあ、個人使用する限りでは使えるレベルかな。
追記
コントロール・パネルのプリンタのところでJUST PDF 3 のアイコンを右クリックして「印刷設定」を選び、
「詳細セットの選択・設定」をクリック。
「フォント」のドロップダウンリストで「埋め込まない」を選択すると、
なんと、わづか3KBに!!!!!!!!
追記
上で
実は、Application.ActivePrinterの返り値では、ポートの所が「Ne0X:」となっているんだが、ネットワーク上のプリンタの場合、ポートの所を「Ne0X:」で指定するとエラーになる（プリンタのIPアドレスで指定しないとダメ。「JUST PDF 3」の場合だと、「on JUST PDF 3 Port:」と指定する）。
と書いていたのだが、現在、自宅（USBジカ付け）でも職場（ネットワーク上）でも「[プリンタ名] on Ne0X:」の形でフツーに指定できている。何がどうなっているのか、よく分からないのだが……。
プリンタ名の取得については、コチラもどうぞ。
