LotusNotesのメール作成・送信をフルオート化してみた
LotusNotesでメール作成→送信をフルオートにする
LotusNotesでメールを送る作業が大量発生したときは、メール自動作成ツールで対応している。
ただ、誤送信が怖いので、基本的にメール作成までは自動でやっても、送信自体は手作業でやっていた。
しかしながら、ついに背に腹は替えられぬようになり、作成・送信フルオートをやってみた。
作業の手順としては、
といった感じ。
フルオート送信の壁
これまでのマクロに、「送信」という過程と「次へ移る」という過程を付け加えるだけなので、楽勝だと思っていたんだが、いざやってみると、
- 送信後、閉じるときに「……保存しますか？ [はい][いいえ]」という確認メッセージが出てしまう
- メール作成後のNotesDocumentクラスのSaveメソッドを実行しなければ確認メッセージは出ないが、送信履歴に残らない
という問題が生じた。
復習～LotusNotesのメールができるまで
【スキップ】
ちょっと復習として、LotusNotesでメールができるまでの処理の過程をおさらいしておく。興味がなかったら上の「スキップ」リンクを踏んだら下にワープするのでどうぞ。
やっとクラスリファレンスの読み方が分かってきたので、自身の勉強のために書くだけ。よって、説明の中には素人の推定によるものも含まれているｗ
Notesメールができるまで
- NotesSessionクラスのインスタンスを作成
→これで現在使用中のNotesのいろんなものが使える。 - NotesUIWorkSpaceクラスのインスタンスを作成
→これでNotesのワークスペースのうち、現在使用中のウインドウが使える - NotesDatabaseクラスのインスタンスを作成
→これで現在使用中のNotesデータベースにアクセスできる。 - NotesDatabaseクラスのOpenMailメソッドで現在のユーザーのメールデータベースを開く
→これでメールデータベースが使える。 - NotesDatabaseクラスのCreateDocumentメソッドを用いて、NotesDocumentクラスのインスタンスを作成
- NotesDocumentクラスのインスタンスに、宛先、件名、受信確認の有無など諸データをセット
- NotesDocumentクラスのCreateRichTextItemメソッドを用いて、NotesRichTextItemクラスのインスタンスを作成
- NotesSessionクラスのCreateRichTextStyleメソッドを用いて、NotesRichTextStyleクラスのインスタンスを作成
- NotesRichTextItemクラスのAppendTextメソッド等を用いて本文を作成
- 必要ならNotesRichTextItemクラスのEmbdedObjectメソッドを用いて添付ファイルを追加
- NotesDocumentクラスのSaveメソッドを用いて文書を保存する
→これで作成したメールがドラフトに保存される。 - NotesUIWorkSpaceクラスのEditDocumentメソッドを用いて、NotesUIDocumentクラスのインスタンスを作成
→これで画面に作成したメールが表示される。
とまあ、こんな手順。
ちょっとづつ分かってきたような気がする。
確認メッセージの表示を防止するのは簡単
上掲Notesメールができるまでの11.、12.の過程は、
リスト１
notesDocument.Save False, False Set notesUIDocument = notesUIWorkSpace.EditDocument(True, notesDocument, False)
というコードになる。※
で、これに「送信→閉じる」という過程を付け加えれば、あとは処理全体をループで回すだけなのだが、単純に
リスト２
notesDocument.Save False, False Set notesUIDocument = notesUIWorkSpace.EditDocument(True, notesDocument, False) CallByName notesUIDocument, "Send", VbMethod, False notesUIDocument.Close True '……(*)'
と書いて実行すると(*)を実行したところで、保存確認のメッセージボックスが出てきてしまう。
VBAでいうところの「Saved」みたいなプロパティはないものか、とクラスリファレンスを探してみると、NotesUIDocumentクラスのリファレンスにSaveメソッドというやつがあった。
そこで、リスト２を
リスト３
notesDocument.Save False, False Set notesUIDocument = notesUIWorkSpace.EditDocument(True, notesDocument, False) CallByName notesUIDocument, "Send", VbMethod, False notesUIDocument.Save '……(*)' notesUIDocument.Close True
このたった１行(*)を加えるだけでうまく行ったｗ
おかげで、80件近くの宛先に文面も添付ファイルも異なるメールを送る、という苦行が便所に行っている間に完了ｗ
おわりに
一昨年の今頃は、まったく意味も分からずに使っていたマクロだが、「クラス」の概念が理解できてきたことによってLotusScriptのクラスリファレンスがだんだん読めるようになってきた。
その結果、コードの意味が分かるようになり、いろいろアレンジを加えることができるようになってきた。
オブジェクト指向を勉強してよかったなあ、と思う今日この頃。
参考～LotusScriptのクラスリファレンス
- NotesSessionクラス
- NotesDatabaseクラス
- NotesUIWorkSpaceクラス
- NotesUIDocumentクラス
- NotesDocumentクラス
- NotesRichTextItemクラス
- NotesRichTextStyleクラス
- NotesEmbededObjectクラス
※
VBAでインタフェースを使ってみた
インタフェースを用いたポリモーフィズムをやってみた
立山秀利さんが著書の中で使っていた音楽プレーヤのたとえが私にとっては一番分かりやすかったので、それをVBAでやってみる。
方針としては、
- 「RecordPlayer」クラス、「CDPlayer」クラス、「MP3Player」クラスの３つのクラスを作る
- ３つのクラスに共通する「音楽を再生する」という機能を「play」メソッドとして括り出す
- 「IMusicPlayer」インタフェースに「play」メソッドを定義する
- 「RecordPlayer」、「CDPlayer」、「MP3Player」の各クラスで「IMusicPlayer」インタフェースを実装する
- 「RecordPlayer」、「CDPlayer」、「MP3Player」の各クラスで「play」メソッドを独自に定義する
これでポリモーフィズムが実現できるはず。
イメージとしては、
音楽を再生する方法はどうあれ、ともかく「play」と命令すればそれぞれのオブジェクトがそれぞれのやり方で音楽を再生する
といったところか。
インタフェースの準備
リスト１ インタフェース「IMusicPlayer」
'クラスモジュール' 'オブジェクト名「IMusicPlayer」' Option Explicit 'Fields' Private Name_ As String 'Accessor' Public Property Get Name() As String Name = Name_ End Property 'Methods' Public Sub play() End Sub
「Name」というプロパティ（フィールド）を持たせていること、あとは「play」というメソッドを持たせているだけ。
特に、メソッドについては、名前を定義しているだけで処理の中身は空っぽ。
具体的な処理は、このインタフェースを実装する各クラスで独自に定義するのだから、これでいいのだ（ですよね？）。
各クラスでのインタフェースの実装
リスト2-1 「RecordPlayer」クラス
'クラスモジュール'
'オブジェクト名「RecordPlayer」'
Option Explicit
Implements IMusicPlayer '……(1)'
'Fields'
Private IMusicPlayer_Name_ As String '……(2)'
'Accessor'
Public Property Get IMusicPlayer_Name() As String '……(3)'
IMusicPlayer_Name = IMusicPlayer_Name_
End Property
'Methods'
Public Sub init(ByVal n As String)
IMusicPlayer_Name_ = n '……(4)'
End Sub
Public Sub IMusicPlayer_play() '……(5)'
Debug.Print "レコードを再生するぜ～♪" & vbCrLf & _
"針が飛ぶから、暴れるんじゃねーぞｗ"
End Sub
ほとんど通常のクラスモジュールと同じ書き方なんだけど、至る所に「IMusicPlayer」というインタフェース名が出てくるところがポイント。
まず(1)、
Implements IMusicPlayer
宣言セクションでこう書く。変なの。
(2)と(3)、フィールド・アクセサの設定も、
Private IMusicPlayer_Name_ As String Public Property Get IMusicPlayer_Name() As String IMusicPlayer_Name = IMusicPlayer_Name_ End Property
「Name」というフィールド（プロパティ）名にいちいち「IMusicPlayer」をスネーク記法で付けないといけない。これも何だかなー。
(4)の
IMusicPlayer_Name_ = n
では、擬似コンストラクタのinitメソッドの引数を受け取っている。当然ここにも「IMusicPlayer」が……。
あと、(5)のメソッド名の定義、
Public Sub IMusicPlayer_play()
にもやっぱり「IMusicPlayer」……。
仕様とはいえ、何だか美しくないんだよなー……。
あと、「CDPlayer」、「MP3Player」についても、やり方は全く同じなので、リストだけ載っけときます。
リスト2-2 「CDPlayer」クラス
'クラスモジュール' 'オブジェクト名「CDPlayer」' Option Explicit Implements IMusicPlayer 'Fields' Private IMusicPlayer_Name_ As String 'Accessor' Public Property Get IMusicPlayer_Name() As String IMusicPlayer_Name = IMusicPlayer_Name_ End Property 'Methods' Public Sub init(ByVal n As String) IMusicPlayer_Name_ = n End Sub Public Sub IMusicPlayer_play() Debug.Print "CDを再生するぜ～♪" End Sub
リスト2-3 「MP3Player」クラス
'クラスモジュール' 'オブジェクト名「MP3Player」' Option Explicit Implements IMusicPlayer 'Fields' Private IMusicPlayer_Name_ As String 'Accessor' Public Property Get IMusicPlayer_Name() As String IMusicPlayer_Name = IMusicPlayer_Name_ End Property 'Methods' Public Sub init(ByVal n As String) IMusicPlayer_Name_ = n End Sub Public Sub IMusicPlayer_play() Debug.Print "MP3を再生するぜ～♪" End Sub
長ったらしくなってすまん。
まあ、これで３つのクラス全てに「IMusicPlayer」インタフェースを実装したことになる。
（「実装」の使い方、これで合ってるんだろうか……？）
ポリモーフィズムをやってみる
次のコードで各種音楽プレーヤを使ってみる。
Option Explicit Public Sub musicPlayerTest() 'インスタンス用変数を準備' '……(1)' Dim cdp As CDPlayer Dim rp As RecordPlayer Dim mp3p As MP3Player 'インスタンス生成＆擬似コンストラクタ発動' '……(2)' Set rp = New RecordPlayer rp.init "レコードプレーヤー１号" Set cdp = New CDPlayer cdp.init "CDプレーヤ１号" Set mp3p = New MP3Player mp3p.init "ストロングマシン１号" 'インタフェース型配列に各インスタンスを格納' '……(3)' Dim iMPlayer(0 To 2) As IMusicPlayer '……(4)' Set iMPlayer(0) = rp '……(5)' Set iMPlayer(1) = cdp Set iMPlayer(2) = mp3p 'Nameプロパティの出力とplayメソッドの実行' '……(6)' Dim i As Integer For i = 0 To 2 With iMPlayer(i) Debug.Print .Name '……(7)' .play '……(8)' End With Next End Sub
(1)の後の３行
Dim cdp As CDPlayer Dim rp As RecordPlayer Dim mp3p As MP3Player
で各音楽プレーヤ用の変数を準備。
(2)の後の６行では、たとえば「RecordPlayer」クラスの場合、
Set rp = New RecordPlayer rp.init "レコードプレーヤー１号"
こんなふうに、インスタンスを生成した後、擬似コンストラクタinitメソッドでNameプロパティを設定している。
「CDPlayer」にしても「MP3Player」にしてもやっていることは同じ。
で、(3)からは、(4)の
Dim iMPlayer(0 To 2) As IMusicPlayer
インタフェース「IMusicPlayer」型の配列変数を用意して、
(5)からの
Set iMPlayer(0) = rp Set iMPlayer(1) = cdp Set iMPlayer(2) = mp3p
でそれぞれのクラスのインスタンスを配列に格納している。
後は、(6)の後の７行、
Dim i As Integer
For i = 0 To 2
With iMPlayer(i)
Debug.Print .Name '……(7)'
.play '……(8)'
End With
Next
で、配列の各要素について、(7)で「Name」プロパティを表示させ、(8)でplayメソッドを実行している。
このとき、配列「iMPlayer」の各要素は、それぞれ別々のクラスのインスタンスなのに、全て同じ名前でプロパティやメソッドが呼び出せているというところがミソ。
実行結果
ほれ。同じメソッド名で呼び出したにもかかわらず、それぞれのクラスがそれぞれのやり方でplayメソッドを実行していることが分かる。
おわりに
正直、まだインタフェースの使いどころについてはピンときていないが、実際にコードを書いてみると、思ったより簡単だった。やっぱり、実際にコードを書いて動かしてみるというのが大事なんだなあ。
……と、ここまで書いてきてから気づいたんだが、
initメソッドもまとめてしまったらよかったんじゃね？
……orz
ちなみに、クラス側でちゃんとメソッドを置かないと、こんなふうに叱られる。
フォルダを作成するクラス
フォルダ作成クラス
任意のディレクトリに任意の名前のフォルダを作る
新規フォルダを作るときは、MkDir関数を使う。
まあ、それはそれでいいのだが、何かこう、作りっぱなし感があって気持ち悪い。
せっかくなので、FileSystemObjectの練習も兼ねて、
フォルダを作るついでにFolderオブジェクトを返り値とするようなメソッドを持たせるクラスを作ってみよう
と思い立った。
相変わらず、何の役に立つのかは分からんがｗ
フォルダを作るクラス
例によってクラスモジュールを挿入し、オブジェクト名を「FolderCreator」とした。
あ、参照設定で「Microsoft Scripting Runtime」にチェックを入れていますよ。
リスト１ クラスモジュールのコード
Option Explicit
'Fields'
Private folderPath_ As String '……(1)'
Private fsObject_ As FileSystemObject
Private createdFolder_ As Folder
'Accessor'
Public Property Get createdFolder() As Folder '……(2)'
Set createdFolder = createdFolder_
End Property
'Constructor'
'Methods'
Public Function init(ByVal rootPath As String, _
ByVal folderName As String) As Folder '……(3)'
folderPath_ = rootPath & "\" & folderName '……(4)''"
If Dir(folderPath_, vbDirectory) = "" Then '……(5)'""
MkDir (folderPath_)
End If
Set fsObject_ = CreateObject("Scripting.FileSystemObject") '……(6)'""
Set createdFolder_ = fsObject_.GetFolder(folderPath_) '……(7)'
Set init = createdFolder_ '……(8)'
End Function
(1)からの３行
Private folderPath_ As String Private fsObject_ As FileSystemObject Private createdFolder_ As Folder
で３つの変数を準備。
「folderPath_」は別にいらないと思うが、一応。後述するinitメソッドの引数を受け取って、新たに作成するフォルダのフルパスを入れるのに使う。
「fsObject」は、FileSystemObjectオブジェクト用の変数。
「createdFolder」に新たに作成したフォルダのFolderオブジェクトを入れる。
(2)の
Public Property Get createdFolder() As Folder Set createdFolder = createdFolder_ End Property
はアクセサメソッド。基本的に新しくできたFolderオブジェクトにだけアクセスできたら、フォルダ名とかフォルダパスなんかはFolderオブジェクトから取得できるので、これで十分だと思う。
(3)から始まるFunctionプロシージャ
Public Function init(ByVal rootPath As String, _
ByVal folderName As String) As Folder
は擬似的なコンストラクタ。
VBAのコンストラクタが引数を持たせられたらいいんだけど、それができないので、
クラスをNewしたら必ず直後にinitメソッドを呼ぶ
ということを決めて、擬似的なコンストラクタとして使う。
第１引数に新しくフォルダを作りたいディレクトリのフルパス、第２引数に新しいフォルダの名前を指定する。
ここからはinitメソッドの中身。
まず、(4)の
folderPath_ = rootPath & "\" & folderName
で新しく作りたいフォルダのフルパス文字列を合成する。
(5)からの３行、
If Dir(folderPath_, vbDirectory) = "" Then MkDir (folderPath_) End If
で同名のフォルダがなければ、MkDir関数でフォルダを作る。
で、(6)の
Set fsObject_ = CreateObject("Scripting.FileSystemObject")
でFileSystemObjectのインスタンスを生成して変数「fsObject」に格納。
(7)の
Set createdFolder_ = fsObject_.GetFolder(folderPath_)
では、さっそくFileSystemObjectオブジェクトのGetFolderメソッドを用いて(5)で作った（もしくはもともとあった）フォルダをFolderオブジェクトとして取得して変数「createdFolder」に格納。
んで、(8)の
Set init = createdFolder
によってFolderPickerオブジェクトをinitメソッドの返り値にしている。
FolderCreatorクラスの使用
下記のコードで使ってみる。
リスト２ 標準モジュールのコード
Public Sub test01()
Dim myFolderCreator As FolderCreator '……(1)'
Set myFolderCreator = New FolderCreator '……(2)'
Dim myFolder As Folder '……(3)'
Set myFolder = myFolderCreator.init(ThisWorkbook.Path, "ち～んｗ") '……(4)'""
With myFolder '……(5)'
Debug.Print .Drive
Debug.Print .ParentFolder
Debug.Print .Name
Debug.Print .Path
End With
End Sub
(1)の
Dim myFolderCreator As FolderCreator
でFolderCreatorクラスのインスタンス用変数「myFolderCreator」を用意。
(2)の
Set myFolderCreator = New FolderCreator
で「myFolderCreator」にFolderCreatorクラスのインスタンスを格納。
(3)の
Dim myFolder As Folder
でinitメソッドの返り値（＝新しく作られるFolderオブジェクト）を受ける変数を用意して、
(4)の
Set myFolder = myFolderCreator.init(ThisWorkbook.Path, "ち～んｗ")
で、マクロを書いたブックのあるフォルダに「ち～んｗ」という名前のフォルダを作成すると同時に、できたFolderオブジェクトを変数「myFolder」に格納している。
あとは、(5)からの６行、
With myFolder Debug.Print .Drive Debug.Print .ParentFolder Debug.Print .Name Debug.Print .Path End With
では、変数「myFolder」に格納されたフォルダ（＝新しく作られたフォルダ）について、
- フォルダの存在するドライブ名（Driveプロパティ）
- フォルダの親フォルダ名（ParentFolderプロパティ）
- フォルダ名（Nameプロパティ）
- フォルダのフルパス（Pathプロパティ）
をイミディエイト・ウインドウに表示させる。
実行結果
ほれ、この通り、新しいフォルダが作られ、
フォルダの属性がちゃーんと取得できる。
おわりに
ただ、このクラスが何に便利なのかはよく分からないｗｗｗ
FileSystemObjectの使いどころについて、もっと勉強しないといけないっぽい。
Addメソッドについて考えた
コレクションのAddメソッドの返り値
Addメソッドの返り値を追加したオブジェクトにするというアイディアを考えたやつは天才
Excelで明細みたいなのを作っていると、それぞれのシートなりブックなりをだいたいはPDF化したり、プリントアウトしたり、という使い方になるんだが、時たま「後で修正する必要があるかも知れんなー」ということで、Excelファイルとして出力したいというときがある。
この間、「一つ一つをExcelファイルにしておきたいなー」と思ってやってみたときにふと気づいたのが標題に書いたAddメソッドの返り値を追加したオブジェクトにするというアイディアを考えたやつは天才ということだった。
シートを新しいブックにコピーして保存するマクロ
仕様は次の通り。
- アクティブシートを新しいブックにコピーする
- 新しくできたブックから、余分なシートを削除する
- コピーしたシートのＡ１セルの値をファイル名として保存する
とまあ、こんな設定。
リスト１
Public Sub copySheetAndCreateNewExcelFile() Dim Sh As Worksheet Set Sh = ActiveSheet Dim newWb As Workbook Dim str As String str = ThisWorkbook.Path & "\それぞれのExcelファイル\" '……(1)'" str = str & Sh.Range("A1").Value & ".xlsx" Set newWb = Workbooks.Add '……(2)' Sh.Copy before:=newWb.Worksheets(1) '……(3)' Application.DisplayAlerts = False '……(4)' Dim i As Integer With newWb '……(5)' For i = .Worksheets.Count To 2 Step -1 .Worksheets(i).Delete Next End With newWb.SaveAs fileName:=str '……(6)' newWb.Close False '……(7)' Application.DisplayAlerts = True '……(8)' End Sub
(1)からの２行、
str = ThisWorkbook.Path & "\それぞれのExcelファイル\" '" str = str & Sh.Range("A1").Value & ".xlsx"
では、新しくできるブックのファイル名を組み立てて変数strに格納している。
単に、後の記述を簡単にするためだけのこと。
(2)がミソ。
「Addメソッド」という名前からは、
コレクションにオブジェクトを加える
というイメージしか湧いてこない。
だから、私のような凡人がAddメソッドを作っていたとしたら
絶対にvoidメソッドにしてしまう
と思う。
「新しくできたオブジェクトを返り値にしよう」などという発想は出てこないと思うのだ。
Addメソッドの返り値が新規に生成されたオブジェクトである、というたったこれだけのことで(2)のように
Set newWb = Workbooks.Add
たったこれだけの記述で新しいオブジェクトを捕まえることができる。これは本当に素晴らしいアイディアだと思う。
言いたいことは言ったので、これで終わってもいいんだが、せっかくなので残りの部分も説明しておこう。
(3)の
Sh.Copy before:=newWb.Worksheets(1)
では、WorksheetオブジェクトのCopyメソッドを用いてシートを新しくできたブックにコピーしている。
引数「Before」に新しいブックの一番左のシートを指定しているので、コピーしたシートは新しいブックの一番左端に入ることになる。
この後、不要なシートを削除していくので、(4)の
Application.DisplayAlerts = False
で、一旦警告メッセージの表示を止める。
(5)からの５行、
With newWb
For i = .Worksheets.Count To 2 Step -1
.Worksheets(i).Delete
Next
End With
で不要なシートを消す。
Excel2010までと2013以降では、デフォルトのシート数が異なるので、Forループの開始値はこんな書き方になる。
コピーしたシートが先頭に挿入されているので、Forループの開始値は、2010までなら４、2013以降なら２ということになる。
Forループの開始値と終了値をケツからさかのぼるような形にしているのがポイント。こうしないと途中でエラーになる（理由は自分で考えよう）。
まあ、
削除するときはケツから！
というのは基本ですな。
あとは、(6)の
newWb.SaveAs fileName:=str
で名前をつけて保存し、
(7)の
newWb.Close False
で新しくできたブックを閉じたらおしまい。
(8)の
Application.DisplayAlerts = True
で警告メッセージの表示を復活させるのをお忘れなく、といったところか。
おわりに
今まで何の気なしに使っていたメソッドだけれど、やはりプロが作ったものはよく考えられている。
自作クラスのメソッドにも応用できるなあと思った。
ワークシートをPDF化する（ExportAsFixedFormatメソッド）
ExportAsFixedFormatメソッドの三態
ExportAsFixedFormatメソッドの対象オブジェクト
よそにデータを送るときに、PDF化する必要があって、WordであれExcelであれ、よくこのExportAsFixedFormatメソッドにはお世話になっている。
んで、改めて調べてみたら、ExcelVBAの場合、対象オブジェクトが３つ（ホントは４つかな？ でもChartオブジェクトとか私は使わないので……）もあると分かった。
すなわち、
の３つ。
まあ、用途というか、実行結果は容易に想像がつく。
上から順に、
- ブック全体をPDF化
- ワークシートをPDF化
- セル範囲をPDF化
ってところだろう。
ExportAsFixedFormatメソッドの使用実験
ワークシートを
こんなふうに用意して、
次のようなコードを書いて実験してみた。
リスト1-1
Private Sub useExportAsFixedFormatMethodOfWorkbook(ByVal filePath As String)
ThisWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=filePath & "ワークブック.pdf" ''
End Sub
リスト1-2
Private Sub useExportAsFixedFormatMethodOfWorksheet(ByVal filePath As String)
Dim Sh As Worksheet
Set Sh = ActiveSheet
Sh.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=filePath & "ワークシート.pdf" ''
End Sub
リスト1-3
Private Sub useExportAsFixedFormatMethodOfRange(ByVal filePath As String)
Dim Sh As Worksheet
Set Sh = ActiveSheet
Sh.Range("Print_Area").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=filePath & "印刷範囲.pdf" ''
End Sub
以上がオブジェクトごとのコード。どれもそれぞれのオブジェクトに対して単純にExportAsFixedFormatメソッドを実行するだけのコードなので特に説明はいらないと思う。
いづれも、引数filePathで保存先のフォルダパスを受け取るので、あとはそれぞれのプロシージャでファイル名を与えている。
リスト1-3では、オブジェクトに印刷範囲を指定している。
で、この３つのコードを、次のリスト２で実行する。
リスト２
Public Sub testPDFCreation() Dim str As String str = ThisWorkbook.Path & "\超人墓場\" '" Call useExportAsFixedFormatMethodOfWorkbook(str) Call useExportAsFixedFormatMethodOfWorksheet(str) Call useExportAsFixedFormatMethodOfRange(str) End Sub
実行結果
見ての通り、Worksheetオブジェクトに対して実行しても、Range("Print_Area")に対して実行しても結果は同じだった。
ちなみに、Workbookオブジェクトに対して実行すると、バカ正直に全てのワークシートの印刷範囲がPDF化された。
おわりに
……ということは、シートの一部だけをPDFにしたい、という事情でもない限り、ワークシートの印刷範囲をPDF化したいのなら、WorksheetオブジェクトのExportAsFixedFormatメソッドを使った方がラク、ということになりそう。
追記
ExportAsFixedFormatメソッドを用いたPDF化の場合、ファイルサイズが異様に大きくなってしまう。
そのあたりが気になる方はコチラをどうぞ。
日付をはじめとする数字の表記の問題
日付の１桁の数字のみ全角にして表示する
変な風習
書類なんかの日付の表記（まあ、日付以外もですけど）について、ウチの職場には、
数字が１桁のときは全角、２桁のときは半角！
という謎ルールがあって、これがWordやExcelを使った作業と本当に相性が悪い。
もちろん、この謎ルールのせいで、使用フォントは見出しが「ＭＳゴシック」、本文が「ＭＳ明朝」のそれぞれ一択ｗ
Wordなんかの場合、デフォルトだと英数字がCentury（だったかな？）なので、「スタイル」とかの知識のない人たちは皆、
- 書類作成
- 全範囲を選択
- フォントを「ＭＳ明朝」（またはＭＳゴシック）に変更
- 完成
という妙な作業をやっている。
こんなアホなことをせんですむように皆さんに説いて回りたいのはやまやまなれど、
誰でもできる仕事が一人前以上フツーに割り振られている上に、私にしかできない仕事が発生したら純粋に上積みで私に回ってくる
という事情、及び
皆「忙しい」が口癖みたいになっているので、教えようとしても迷惑がられる
というのが現状なので、黙っているｗｗｗ
まあ、そんな職場です。
Excelで変な風習に合わせる
せっかくExcelには
データは日付型として持っておいて表示形式だけを操作する
という超便利な機能があるのに、この変な風習のせいでExcelに日付型データを入力するという発想自体が根こそぎ刈り取られているのが実情。
しかし、この状態を放置するのはあまりにむかつくので、
日付データを「１けた全角、ほか半角」方式に変換する関数
を作った。
日付データを「１けた全角、ほか半角」方式に変換する関数
リスト１
Private Function adjustExpressionOfDate(ByVal style As Integer, _
ByVal dt As Date) As String '……(1)'
Dim str As String '……(2)'
Dim m As String
Dim d As String
m = Month(dt) '……(3)'
d = Day(dt)
'第１引数が「WHEN_SINGLE_DIGIT～」だったら１桁の数字を全角にする'
If style = WHEN_SINGLE_DIGIT_EXCHANGE_TO_WIDE Then
If m < 10 Then m = StrConv(m, vbWide) '……(4)'
If d < 10 Then d = StrConv(d, vbWide)
'文字列として結合する'
str = m & "月" & d & "日" & "（" & Format(dt, "aaa") & "）" '……(5)'
adjustExpressionOfDate = str '……(6)'
Exit Function '……(7)'
End If
'第１引数が「WHEN_SINGLE_DIGIT～」でなかったら半角のまま文字列にして返す'
adjustExpressionOfDate = m & "月" & d & "日" & "（" & Format(dt, "aaa") & "）" '……(8)'
End Function
(1)で、
Private Function adjustExpressionOfDate(ByVal style As Integer, _
ByVal dt As Date) As String
２つの引数を渡すようにしている。
第１引数の「style」で変換方式を指定するようにし、
第２引数のdtで日付データを渡すようにした。
「style」については、今回はとりあえず「○月○日（曜日）」という形式を定数「WHEN_SINGLE_DIGIT_EXCHANGE_TO_WIDE」（中身はIntegerの「1」。長っｗ）で指定するようにした。
で、どの道「８月29日（火）」みたいな形にしてしまうともはや日付データとしては扱えないので、返り値はString型にした。
(2)からの３行
Dim str As String Dim m As String Dim d As String
で変数を宣言。それぞれの役割は以下の通り。
- 「str」には最終的にできあがった日付文字列を格納する
※不要ですが、可読性向上のために使う。 - 「m」には月の数字を格納する
- 「d」には日の数字を格納する
(3)からの２行
m = Month(dt) d = Day(dt)
で変数「m」、「d」にそれぞれ月・日の数値を代入。
この関数に渡された第１引数が「WHEN_SINGLE_DIGIT_EXCHANGE_TO_WIDE」だったら、(4)以下の処理に移る。
(4)からの２行
If m < 10 Then m = StrConv(m, vbWide) If d < 10 Then d = StrConv(d, vbWide)
で、それぞれ１桁だったら全角に変換する。
あとは、(5)の
str = m & "月" & d & "日" & "（" & Format(dt, "aaa") & "）"
で「○月○日（曜日）」の形式になるように整形して変数「str」に代入。
(6)の
adjustExpressionOfDate = str
で返り値を設定し、(7)の
Exit Function
で呼び出し元に帰る。
ここでExitするのは、後々の拡張性のため。
今回は「○月○日（曜日）」の形式だったが、今後
「元号も入れんかい！」
とか後出しジャンケンされたときには、その処理を書いて、第１引数の「style」で分岐できるようにすればよい。
(8)の
adjustExpressionOfDate = m & "月" & d & "日" & "（" & Format(dt, "aaa") & "）"
を最後に書いているのはそういうこと。
実行結果
この状態で、次のコードを書いて実行。
リスト２
Public Sub getAdjustedDateString()
ActiveCell.Offset(0, 1).Value = _
adjustExpressionOfDate(WHEN_SINGLE_DIGIT_EXCHANGE_TO_WIDE, _
ActiveCell.Value)
End Sub
無事に変換された。
ちなみに、月、日ともに１桁でも
この通り大丈夫。
文字の位置がそろっていないのはプロポーショナルフォントにしているせい。
みんな大好き（笑）「ＭＳゴシック」にすると……。
ほれ、このとおりピッタリそろった！ よかったねｗ
おわりに
しっかし、こんなしょうもないことに神経を使うなんて、それこそ無駄だと思うんですけど。
こんな謎風習を生きながらえさせている上長には「働き方改革」とかほざいてほしくないっす。
構造体の要素を並べ替える
構造体配列の要素をパラメータの値に従ってソートする
なんかこう、仕事が泥沼で、長らく更新できませんでした。今も泥沼の最中なんですが、現実逃避して書いています。
さて、仕事で希望調査みたいなのをやった。まあ、データ集約するだけなら楽勝だったんだけれど、問題発生。
希望（日付入り）を３つ挙げる、という項目があったんだが、「第１希望～第３希望」みたいな書き方になっていたため、３つが日付順に並んでいない回答が結構あったということ。
集約したときに人によって並び順が違う、というのはあまりにブサイク。しかも後から「おい、これ日付順に並び方を統一しとかんかい」とか言われたら死ぬので、今のうちに対応しておかないと……と考えた。
イメージはこんな感じ。
たとえば、「中野 浩一」さんの場合だと、
久留米（8/1）→小倉（7/29）→佐世保（7/28）
と並んでいるやつを、
佐世保（7/28）→小倉（7/29）→久留米（8/1）
という順に列ごと並べ替えたいわけなんである。
作戦
で、次のような作戦を考えた。
こんな感じ。
構造体の作成
標準モジュールの宣言セクションで以下のように設定。
リスト１
Option Explicit Public Type wishData personName As String wishPlace1 As String wishDate1 As Date wishPlace2 As String wishDate2 As Date wishPlace3 As String wishDate3 As Date End Type
構造体配列に各人のデータをセット
リスト２
Dim Sh As Worksheet
Set Sh = ActiveSheet
Dim wsData(4) As wishData '……(1)'
Dim i As Integer
'データを配列にセット'
For i = 0 To 4 '……(2)'
With wsData(i)
.personName = Sh.Range("S" & i + 3).Value
.wishPlace1 = Sh.Range("T" & i + 3).Value
.wishDate1 = Sh.Range("U" & i + 3).Value
.wishPlace2 = Sh.Range("V" & i + 3).Value
.wishDate2 = Sh.Range("W" & i + 3).Value
.wishPlace3 = Sh.Range("X" & i + 3).Value
.wishDate3 = Sh.Range("Y" & i + 3).Value
End With
Next
かなり原始的な書き方になっているのはご容赦ください。
(1)の
Dim wsData(4) As wishData
でとりあえず５人分の配列変数を準備して、
(2)からの11行
For i = 0 To 4 '……(2)'
With wsData(i)
.personName = Sh.Range("S" & i + 3).Value
.wishPlace1 = Sh.Range("T" & i + 3).Value
.wishDate1 = Sh.Range("U" & i + 3).Value
.wishPlace2 = Sh.Range("V" & i + 3).Value
.wishDate2 = Sh.Range("W" & i + 3).Value
.wishPlace3 = Sh.Range("X" & i + 3).Value
.wishDate3 = Sh.Range("Y" & i + 3).Value
End With
Next
で５人分のデータを配列に格納しているだけ。
構造体内の要素を並べ替える
「wishDate1」～「wishDate3」の大小によって、構造体内の要素を入れ替える処理が必要。
メンドクサイのは、場所データ（wishPlace○）と日付データ（wishData○）をセットで入れ替えないといけない点。
アホみたいなやり方だと笑われそうだけど、次のような専用プロシージャを作った。
基本的なやり方は、入れ替え前の構造体をobjDataとすると、
- objDataの２番目の日付と３番目の日付を比較する
- ２番目の日付の方が大きかったら、一旦tmpDataにobjDataを丸ごとコピーする
- objDataの２番目の場所・日付データのところに３番目の場所・日付を上書きする
- objDataの２番目の場所・日付データのところにtmpDataの３番目の場所・日付を上書きする
※これで３番目と２番目が入れ替わる。 - objDataの１番目の日付と２番目の日付を比較する
- １番目の日付の方が大きかったら、同様にobjDataの１番目と２番目を入れ替える
※この段階で一番小さな日付・場所が１番目に来ている。 - objDataの３番目の日付と２番目の日付を比較する
- ２番目の日付の方が大きかったら、同様にobjDataの２番目と３番目を入れ替える
- 並べ替え完了
バブルソートってやつですね。
リスト３
Private Sub sortDataByDate(ByRef objData As wishData)
Dim tmpData As wishData
With objData
'バブルソート１回目'
If .wishDate2 > .wishDate3 Then
tmpData = objData '……(1)'
.wishPlace3 = .wishPlace2 '……(2)'
.wishDate3 = .wishDate2 '……(3)'
.wishPlace2 = tmpData.wishPlace3 '……(4)'
.wishDate2 = tmpData.wishDate3 '……(5)'
End If
'バブルソート２回目'
If .wishDate1 > .wishDate2 Then
tmpData = objData
.wishPlace2 = .wishPlace1
.wishDate2 = .wishDate1
.wishPlace1 = tmpData.wishPlace2
.wishDate1 = tmpData.wishDate2
End If
'バブルソート３回目'
If .wishDate2 > .wishDate3 Then
tmpData = objData
.wishPlace3 = .wishPlace2
.wishDate3 = .wishDate2
.wishPlace2 = tmpData.wishPlace3
.wishDate2 = tmpData.wishDate3
End If
End With
End Sub
うーむ、我ながら吐き気を催すようなぶさいくなコードｗｗｗ
いちおう、データ入れ替えのところだけ説明します。
「バブルソート１回目」の部分、
'バブルソート１回目' If .wishDate2 > .wishDate3 Then tmpData = objData '……(1)' .wishPlace3 = .wishPlace2 '……(2)' .wishDate3 = .wishDate2 '……(3)' .wishPlace2 = tmpData.wishPlace3 '……(4)' .wishDate2 = tmpData.wishDate3 '……(5)' End If
まず、２番目の日付と３番目の日付を比較して、２番目の方が大きかったら(1)以下で２番目の要素と３番目の要素を入れ替える。
(1)で元のデータをtmpDataに格納しておいて、
(2)、(3)で２番目だったデータを３番目のところに上書きし、
(4)、(5)でtmpDataに避難しておいたデータを用いて２番目のところに元々３番目だったデータを上書きする
という段取り。
構造体変数を引数にするときには、参照渡ししかできないみたいなので、Functionにする必要がなかった。
このプロシージャを呼び出して並べ替える。そのためのコードがコチラ。
リスト４
For i = 0 To 4 Call sortDataByDate(wsData(i)) Next
これだけです。Forループで i 番目のwsDataを渡しています。
シートに書き出す
今回は、別の場所に転記先の表を作った。
リスト５
For i = 0 To 4
With wsData(i)
Sh.Range("AA" & i + 3).Value = .personName
Sh.Range("AB" & i + 3).Value = .wishPlace1
Sh.Range("AC" & i + 3).Value = .wishDate1
Sh.Range("AD" & i + 3).Value = .wishPlace2
Sh.Range("AE" & i + 3).Value = .wishDate2
Sh.Range("AF" & i + 3).Value = .wishPlace3
Sh.Range("AG" & i + 3).Value = .wishDate3
End With
Next
何の工夫もない書き方ですんません。
コード全体
いちおう全体を挙げておきます。
リスト全体
Option Explicit
'構造体の宣言'
Public Type wishData
personName As String
wishPlace1 As String
wishDate1 As Date
wishPlace2 As String
wishDate2 As Date
wishPlace3 As String
wishDate3 As Date
End Type
Public Sub exchangeWishList()
Dim Sh As Worksheet
Set Sh = ActiveSheet
Dim wsData(4) As wishData
Dim i As Integer
'データを配列にセット'
For i = 0 To 4
With wsData(i)
.personName = Sh.Range("S" & i + 3).Value
.wishPlace1 = Sh.Range("T" & i + 3).Value
.wishDate1 = Sh.Range("U" & i + 3).Value
.wishPlace2 = Sh.Range("V" & i + 3).Value
.wishDate2 = Sh.Range("W" & i + 3).Value
.wishPlace3 = Sh.Range("X" & i + 3).Value
.wishDate3 = Sh.Range("Y" & i + 3).Value
End With
Next
'構造体配列の要素並べ替え'
For i = 0 To 4
Call sortDataByDate(wsData(i))
Next
'シートに書き出す'
For i = 0 To 4
With wsData(i)
Sh.Range("AA" & i + 3).Value = .personName
Sh.Range("AB" & i + 3).Value = .wishPlace1
Sh.Range("AC" & i + 3).Value = .wishDate1
Sh.Range("AD" & i + 3).Value = .wishPlace2
Sh.Range("AE" & i + 3).Value = .wishDate2
Sh.Range("AF" & i + 3).Value = .wishPlace3
Sh.Range("AG" & i + 3).Value = .wishDate3
End With
Next
End Sub
'並べ替え用プロシージャ'
Private Sub sortDataByDate(ByRef objData As wishData)
Dim tmpData As wishData
With objData
'バブルソート１回目'
If .wishDate2 > .wishDate3 Then
tmpData = objData
.wishPlace3 = .wishPlace2
.wishDate3 = .wishDate2
.wishPlace2 = tmpData.wishPlace3
.wishDate2 = tmpData.wishDate3
End If
'バブルソート２回目'
If .wishDate1 > .wishDate2 Then
tmpData = objData
.wishPlace2 = .wishPlace1
.wishDate2 = .wishDate1
.wishPlace1 = tmpData.wishPlace2
.wishDate1 = tmpData.wishDate2
End If
'バブルソート３回目'
If .wishDate2 > .wishDate3 Then
tmpData = objData
.wishPlace3 = .wishPlace2
.wishDate3 = .wishDate2
.wishPlace2 = tmpData.wishPlace3
.wishDate2 = tmpData.wishDate3
End If
End With
End Sub
実行結果
実行前
実行後
ちゃんと日付順に整理された。
おわりに
うーん……。このままだとまるで応用が利かないなあ。
