LotusNotesのメール作成・送信をフルオート化してみた

LotusNotesでメール作成→送信をフルオートにする

LotusNotesでメールを送る作業が大量発生したときは、メール自動作成ツールで対応している。

akashi-keirin.hatenablog.com

ただ、誤送信が怖いので、基本的にメール作成までは自動でやっても、送信自体は手作業でやっていた。

しかしながら、ついに背に腹は替えられぬようになり、作成・送信フルオートをやってみた。

作業の手順としては、

  1. Excelファイルにメール作成用のデータを作成
  2. 1.をもとに、このときのマクロを使ってメールを作成
  3. 送信
  4. 文書を閉じて次へ

といった感じ。

フルオート送信の壁

これまでのマクロに、「送信」という過程と「次へ移る」という過程を付け加えるだけなので、楽勝だと思っていたんだが、いざやってみると、

  • 送信後、閉じるときに「……保存しますか? [はい][いいえ]」という確認メッセージが出てしまう
  • メール作成後のNotesDocumentクラスのSaveメソッドを実行しなければ確認メッセージは出ないが、送信履歴に残らない

という問題が生じた。

復習~LotusNotesのメールができるまで

スキップ

ちょっと復習として、LotusNotesでメールができるまでの処理の過程をおさらいしておく。興味がなかったら上の「スキップ」リンクを踏んだら下にワープするのでどうぞ。

やっとクラスリファレンスの読み方が分かってきたので、自身の勉強のために書くだけ。よって、説明の中には素人の推定によるものも含まれているw

Notesメールができるまで
  1. NotesSessionクラスのインスタンスを作成
    →これで現在使用中のNotesのいろんなものが使える。
  2. 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.の過程は、

リスト1
notesDocument.Save False, False
Set notesUIDocument = notesUIWorkSpace.EditDocument(True, notesDocument, False)

というコードになる。

で、これに「送信→閉じる」という過程を付け加えれば、あとは処理全体をループで回すだけなのだが、単純に

スト2
notesDocument.Save False, False
Set notesUIDocument = notesUIWorkSpace.EditDocument(True, notesDocument, False)
CallByName notesUIDocument, "Send", VbMethod, False
notesUIDocument.Close True    '……(*)'

と書いて実行すると(*)を実行したところで、保存確認のメッセージボックスが出てきてしまう。

VBAでいうところの「Saved」みたいなプロパティはないものか、とクラスリファレンスを探してみると、NotesUIDocumentクラスのリファレンスSaveメソッドというやつがあった。

そこで、リスト2

リスト3
notesDocument.Save False, False
Set notesUIDocument = notesUIWorkSpace.EditDocument(True, notesDocument, False)
CallByName notesUIDocument, "Send", VbMethod, False
notesUIDocument.Save    '……(*)'
notesUIDocument.Close True

このたった1行(*)を加えるだけでうまく行ったw

おかげで、80件近くの宛先に文面も添付ファイルも異なるメールを送る、という苦行が便所に行っている間に完了w

おわりに

一昨年の今頃は、まったく意味も分からずに使っていたマクロだが、「クラス」の概念が理解できてきたことによってLotusScriptのクラスリファレンスがだんだん読めるようになってきた。

その結果、コードの意味が分かるようになり、いろいろアレンジを加えることができるようになってきた。

オブジェクト指向を勉強してよかったなあ、と思う今日この頃。

参考~LotusScriptのクラスリファレンス

VBAでインタフェースを使ってみた

インタフェースを用いたポリモーフィズムをやってみた

立山秀利さんが著書の中で使っていた音楽プレーヤのたとえが私にとっては一番分かりやすかったので、それをVBAでやってみる。

方針としては、

  1. 「RecordPlayer」クラス、「CDPlayer」クラス、「MP3Player」クラスの3つのクラスを作る
  2. 3つのクラスに共通する「音楽を再生する」という機能を「play」メソッドとして括り出す
  3. 「IMusicPlayer」インタフェースに「play」メソッドを定義する
  4. 「RecordPlayer」、「CDPlayer」、「MP3Player」の各クラスで「IMusicPlayer」インタフェースを実装する
  5. 「RecordPlayer」、「CDPlayer」、「MP3Player」の各クラスで「play」メソッドを独自に定義する

これでポリモーフィズムが実現できるはず。

イメージとしては、

音楽を再生する方法はどうあれ、ともかく「play」と命令すればそれぞれのオブジェクトがそれぞれのやり方で音楽を再生する

といったところか。

インタフェースの準備

リスト1 インタフェース「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 & _
              "針が飛ぶから、暴れるんじゃねーぞw"
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

長ったらしくなってすまん。

まあ、これで3つのクラス全てに「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 "レコードプレーヤー1号"
  Set cdp = New CDPlayer
  cdp.init "CDプレーヤ1号"
  Set mp3p = New MP3Player
  mp3p.init "ストロングマシン1号"
  'インタフェース型配列に各インスタンスを格納'    '……(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)の後の3行

Dim cdp As CDPlayer
Dim rp As RecordPlayer
Dim mp3p As MP3Player

で各音楽プレーヤ用の変数を準備。

(2)の後の6行では、たとえば「RecordPlayer」クラスの場合、

Set rp = New RecordPlayer
rp.init "レコードプレーヤー1号"

こんなふうに、インスタンスを生成した後、擬似コンストラクタ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)の後の7行、

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」の各要素は、それぞれ別々のクラスのインスタンスなのに、全て同じ名前でプロパティやメソッドが呼び出せているというところがミソ。

実行結果

f:id:akashi_keirin:20170619050311j:plain

ほれ。同じメソッド名で呼び出したにもかかわらず、それぞれのクラスがそれぞれのやり方でplayメソッドを実行していることが分かる。

おわりに

正直、まだインタフェースの使いどころについてはピンときていないが、実際にコードを書いてみると、思ったより簡単だった。やっぱり、実際にコードを書いて動かしてみるというのが大事なんだなあ。

……と、ここまで書いてきてから気づいたんだが、

initメソッドもまとめてしまったらよかったんじゃね?

……orz

f:id:akashi_keirin:20170619050303j:plain

ちなみに、クラス側でちゃんとメソッドを置かないと、こんなふうに叱られる。

@akashi_keirin on Twitter

フォルダを作成するクラス

フォルダ作成クラス

任意のディレクトリに任意の名前のフォルダを作る

新規フォルダを作るときは、MkDir関数を使う。

まあ、それはそれでいいのだが、何かこう、作りっぱなし感があって気持ち悪い。

せっかくなので、FileSystemObjectの練習も兼ねて、

フォルダを作るついでにFolderオブジェクトを返り値とするようなメソッドを持たせるクラスを作ってみよう

と思い立った。

相変わらず、何の役に立つのかは分からんがw

フォルダを作るクラス

例によってクラスモジュールを挿入し、オブジェクト名を「FolderCreator」とした。

あ、参照設定で「Microsoft Scripting Runtime」にチェックを入れていますよ。

リスト1 クラスモジュールのコード
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)からの3行

Private folderPath_ As String
Private fsObject_ As FileSystemObject
Private createdFolder_ As Folder

で3つの変数を準備。

「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メソッドを呼ぶ

ということを決めて、擬似的なコンストラクタとして使う。

第1引数に新しくフォルダを作りたいディレクトリのフルパス、第2引数に新しいフォルダの名前を指定する。

ここからはinitメソッドの中身。

まず、(4)の

folderPath_ = rootPath & "\" & folderName

で新しく作りたいフォルダのフルパス文字列を合成する。

(5)からの3行、

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クラスの使用

下記のコードで使ってみる。

スト2 標準モジュールのコード
Public Sub test01()
  Dim myFolderCreator As FolderCreator    '……(1)'
  Set myFolderCreator = New FolderCreator    '……(2)'
  Dim myFolder As Folder    '……(3)'
  Set myFolder = myFolderCreator.init(ThisWorkbook.Path, "ち~んw")    '……(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, "ち~んw")

で、マクロを書いたブックのあるフォルダに「ち~んw」という名前のフォルダを作成すると同時に、できたFolderオブジェクトを変数「myFolder」に格納している。

あとは、(5)からの6行、

With myFolder
  Debug.Print .Drive
  Debug.Print .ParentFolder
  Debug.Print .Name
  Debug.Print .Path
End With

では、変数「myFolder」に格納されたフォルダ(=新しく作られたフォルダ)について、

  • フォルダの存在するドライブ名(Driveプロパティ)
  • フォルダの親フォルダ名(ParentFolderプロパティ)
  • フォルダ名(Nameプロパティ)
  • フォルダのフルパス(Pathプロパティ)


をイミディエイト・ウインドウに表示させる。

実行結果

f:id:akashi_keirin:20170618084334j:plain

ほれ、この通り、新しいフォルダが作られ、

f:id:akashi_keirin:20170618084342j:plain

フォルダの属性がちゃーんと取得できる。

おわりに

ただ、このクラスが何に便利なのかはよく分からないwww

FileSystemObjectの使いどころについて、もっと勉強しないといけないっぽい。

@akashi_keirin on Twitter

Addメソッドについて考えた

コレクションのAddメソッドの返り値

Addメソッドの返り値を追加したオブジェクトにするというアイディアを考えたやつは天才

Excelで明細みたいなのを作っていると、それぞれのシートなりブックなりをだいたいはPDF化したり、プリントアウトしたり、という使い方になるんだが、時たま「後で修正する必要があるかも知れんなー」ということで、Excelファイルとして出力したいというときがある。

この間、「一つ一つをExcelファイルにしておきたいなー」と思ってやってみたときにふと気づいたのが標題に書いたAddメソッドの返り値を追加したオブジェクトにするというアイディアを考えたやつは天才ということだった。

シートを新しいブックにコピーして保存するマクロ

仕様は次の通り。

  1. アクティブシートを新しいブックにコピーする
  2. 新しくできたブックから、余分なシートを削除する
  3. コピーしたシートのA1セルの値をファイル名として保存する

とまあ、こんな設定。

リスト1
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)からの2行、

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)からの5行、

With newWb
  For i = .Worksheets.Count To 2 Step -1
    .Worksheets(i).Delete
  Next
End With

で不要なシートを消す。

Excel2010までと2013以降では、デフォルトのシート数が異なるので、Forループの開始値はこんな書き方になる。

コピーしたシートが先頭に挿入されているので、Forループの開始値は、2010までなら4、2013以降なら2ということになる。

Forループの開始値と終了値をケツからさかのぼるような形にしているのがポイント。こうしないと途中でエラーになる(理由は自分で考えよう)。

まあ、

削除するときはケツから!

というのは基本ですな。

あとは、(6)の

newWb.SaveAs fileName:=str

で名前をつけて保存し、

(7)の

newWb.Close False

で新しくできたブックを閉じたらおしまい。

(8)の

Application.DisplayAlerts = True

で警告メッセージの表示を復活させるのをお忘れなく、といったところか。

おわりに

今まで何の気なしに使っていたメソッドだけれど、やはりプロが作ったものはよく考えられている。

自作クラスのメソッドにも応用できるなあと思った。

@akashi_keirin on Twitter

ワークシートをPDF化する(ExportAsFixedFormatメソッド)

ExportAsFixedFormatメソッドの三態

ExportAsFixedFormatメソッドの対象オブジェクト

よそにデータを送るときに、PDF化する必要があって、WordであれExcelであれ、よくこのExportAsFixedFormatメソッドにはお世話になっている。

んで、改めて調べてみたら、ExcelVBAの場合、対象オブジェクトが3つ(ホントは4つかな? でもChartオブジェクトとか私は使わないので……)もあると分かった。

すなわち、


の3つ。

まあ、用途というか、実行結果は容易に想像がつく。

上から順に、

  • ブック全体をPDF化
  • ワークシートをPDF化
  • セル範囲をPDF化


ってところだろう。

ExportAsFixedFormatメソッドの使用実験

ワークシートを

f:id:akashi_keirin:20170617230534j:plain

f:id:akashi_keirin:20170617230545j:plain

こんなふうに用意して、

次のようなコードを書いて実験してみた。

リスト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では、オブジェクトに印刷範囲を指定している。

で、この3つのコードを、次のリスト2で実行する。

スト2
Public Sub testPDFCreation()
  Dim str As String
  str = ThisWorkbook.Path & "\超人墓場\" '"
  Call useExportAsFixedFormatMethodOfWorkbook(str)
  Call useExportAsFixedFormatMethodOfWorksheet(str)
  Call useExportAsFixedFormatMethodOfRange(str)
End Sub
実行結果

f:id:akashi_keirin:20170617230552j:plain

f:id:akashi_keirin:20170617230607j:plain

見ての通り、Worksheetオブジェクトに対して実行しても、Range("Print_Area")に対して実行しても結果は同じだった。

ちなみに、Workbookオブジェクトに対して実行すると、バカ正直に全てのワークシートの印刷範囲がPDF化された。

おわりに

……ということは、シートの一部だけをPDFにしたい、という事情でもない限り、ワークシートの印刷範囲をPDF化したいのなら、WorksheetオブジェクトのExportAsFixedFormatメソッドを使った方がラク、ということになりそう。

@akashi_keirin on Twitter

日付をはじめとする数字の表記の問題

日付の1桁の数字のみ全角にして表示する

変な風習

書類なんかの日付の表記(まあ、日付以外もですけど)について、ウチの職場には、

数字が1桁のときは全角、2桁のときは半角!

という謎ルールがあって、これがWordやExcelを使った作業と本当に相性が悪い。

もちろん、この謎ルールのせいで、使用フォントは見出しが「MSゴシック」、本文が「MS明朝」のそれぞれ一択w

Wordなんかの場合、デフォルトだと英数字がCentury(だったかな?)なので、「スタイル」とかの知識のない人たちは皆、

  • 書類作成
  • 全範囲を選択
  • フォントを「MS明朝」(またはMSゴシック)に変更
  • 完成

という妙な作業をやっている。

こんなアホなことをせんですむように皆さんに説いて回りたいのはやまやまなれど、

誰でもできる仕事が一人前以上フツーに割り振られている上に、私にしかできない仕事が発生したら純粋に上積みで私に回ってくる

という事情、及び

皆「忙しい」が口癖みたいになっているので、教えようとしても迷惑がられる

というのが現状なので、黙っているwww

まあ、そんな職場です。

Excelで変な風習に合わせる

せっかくExcelには

データは日付型として持っておいて表示形式だけを操作する

という超便利な機能があるのに、この変な風習のせいでExcelに日付型データを入力するという発想自体が根こそぎ刈り取られているのが実情。

しかし、この状態を放置するのはあまりにむかつくので、

日付データを「1けた全角、ほか半角」方式に変換する関数

を作った。

日付データを「1けた全角、ほか半角」方式に変換する関数

リスト1
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)
  '第1引数が「WHEN_SINGLE_DIGIT~」だったら1桁の数字を全角にする'
  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
  '第1引数が「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

2つの引数を渡すようにしている。

第1引数の「style」で変換方式を指定するようにし、
第2引数のdtで日付データを渡すようにした。

「style」については、今回はとりあえず「○月○日(曜日)」という形式を定数「WHEN_SINGLE_DIGIT_EXCHANGE_TO_WIDE」(中身はIntegerの「1」。長っw)で指定するようにした。

で、どの道「8月29日(火)」みたいな形にしてしまうともはや日付データとしては扱えないので、返り値はString型にした。

(2)からの3行

Dim str As String
Dim m As String
Dim d As String

で変数を宣言。それぞれの役割は以下の通り。

  • 「str」には最終的にできあがった日付文字列を格納する
    ※不要ですが、可読性向上のために使う。
  • 「m」には月の数字を格納する
  • 「d」には日の数字を格納する

(3)からの2行

m = Month(dt)
d = Day(dt)

で変数「m」、「d」にそれぞれ月・日の数値を代入。

この関数に渡された第1引数が「WHEN_SINGLE_DIGIT_EXCHANGE_TO_WIDE」だったら、(4)以下の処理に移る。

(4)からの2行

If m < 10 Then m = StrConv(m, vbWide)
If d < 10 Then d = StrConv(d, vbWide)

で、それぞれ1桁だったら全角に変換する。

あとは、(5)の

str = m & "月" & d & "日" & "(" & Format(dt, "aaa") & ")"

で「○月○日(曜日)」の形式になるように整形して変数「str」に代入。

(6)の

adjustExpressionOfDate = str

で返り値を設定し、(7)の

Exit Function

で呼び出し元に帰る。

ここでExitするのは、後々の拡張性のため。

今回は「○月○日(曜日)」の形式だったが、今後

元号も入れんかい!」

とか後出しジャンケンされたときには、その処理を書いて、第1引数の「style」で分岐できるようにすればよい。

(8)の

adjustExpressionOfDate = m & "月" & d & "日" & "(" & Format(dt, "aaa") & ")"

を最後に書いているのはそういうこと。

実行結果

f:id:akashi_keirin:20170611101901j:plain

この状態で、次のコードを書いて実行。

スト2
Public Sub getAdjustedDateString()
  ActiveCell.Offset(0, 1).Value = _
    adjustExpressionOfDate(WHEN_SINGLE_DIGIT_EXCHANGE_TO_WIDE, _
                           ActiveCell.Value)
End Sub

f:id:akashi_keirin:20170611101908j:plain

無事に変換された。

ちなみに、月、日ともに1桁でも

f:id:akashi_keirin:20170611101916j:plain

この通り大丈夫。

文字の位置がそろっていないのはプロポーショナルフォントにしているせい。

みんな大好き(笑)「MSゴシック」にすると……。

f:id:akashi_keirin:20170611101922j:plain

ほれ、このとおりピッタリそろった! よかったねw

おわりに

しっかし、こんなしょうもないことに神経を使うなんて、それこそ無駄だと思うんですけど。

こんな謎風習を生きながらえさせている上長には「働き方改革」とかほざいてほしくないっす。

@akashi_keirin on Twitter

構造体の要素を並べ替える

構造体配列の要素をパラメータの値に従ってソートする

なんかこう、仕事が泥沼で、長らく更新できませんでした。今も泥沼の最中なんですが、現実逃避して書いています。

さて、仕事で希望調査みたいなのをやった。まあ、データ集約するだけなら楽勝だったんだけれど、問題発生。

希望(日付入り)を3つ挙げる、という項目があったんだが、「第1希望~第3希望」みたいな書き方になっていたため、3つが日付順に並んでいない回答が結構あったということ。

集約したときに人によって並び順が違う、というのはあまりにブサイク。しかも後から「おい、これ日付順に並び方を統一しとかんかい」とか言われたら死ぬので、今のうちに対応しておかないと……と考えた。

イメージはこんな感じ。

f:id:akashi_keirin:20170604082519j:plain

たとえば、「中野 浩一」さんの場合だと、

久留米(8/1)→小倉(7/29)→佐世保(7/28)

と並んでいるやつを、

佐世保(7/28)→小倉(7/29)→久留米(8/1)

という順に列ごと並べ替えたいわけなんである。

作戦

で、次のような作戦を考えた。

  1. 各人のデータを構造体変数にまとめて、配列に格納する
  2. 各構造体の日付パラメータをもとに、バブルソートアルゴリズムを用いて並べ変える
  3. 表に書き出す

こんな感じ。

構造体の作成

標準モジュールの宣言セクションで以下のように設定。

リスト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

構造体配列に各人のデータをセット

スト2
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

でとりあえず5人分の配列変数を準備して、

(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

で5人分のデータを配列に格納しているだけ。

構造体内の要素を並べ替える

「wishDate1」~「wishDate3」の大小によって、構造体内の要素を入れ替える処理が必要。

メンドクサイのは、場所データ(wishPlace○)と日付データ(wishData○)をセットで入れ替えないといけない点。

アホみたいなやり方だと笑われそうだけど、次のような専用プロシージャを作った。

基本的なやり方は、入れ替え前の構造体をobjDataとすると、

  1. objDataの2番目の日付と3番目の日付を比較する
  2. 2番目の日付の方が大きかったら、一旦tmpDataにobjDataを丸ごとコピーする
  3. objDataの2番目の場所・日付データのところに3番目の場所・日付を上書きする
  4. objDataの2番目の場所・日付データのところにtmpDataの3番目の場所・日付を上書きする
    ※これで3番目と2番目が入れ替わる。
  5. objDataの1番目の日付と2番目の日付を比較する
  6. 1番目の日付の方が大きかったら、同様にobjDataの1番目と2番目を入れ替える
    ※この段階で一番小さな日付・場所が1番目に来ている。
  7. objDataの3番目の日付と2番目の日付を比較する
  8. 2番目の日付の方が大きかったら、同様にobjDataの2番目と3番目を入れ替える
  9. 並べ替え完了

バブルソートってやつですね。

リスト3
Private Sub sortDataByDate(ByRef objData As wishData)
  Dim tmpData As wishData
  With objData
    'バブルソート1回目'
    If .wishDate2 > .wishDate3 Then
      tmpData = objData    '……(1)'
      .wishPlace3 = .wishPlace2    '……(2)'
      .wishDate3 = .wishDate2    '……(3)'
      .wishPlace2 = tmpData.wishPlace3    '……(4)'
      .wishDate2 = tmpData.wishDate3    '……(5)'
    End If
    'バブルソート2回目'
    If .wishDate1 > .wishDate2 Then
      tmpData = objData
      .wishPlace2 = .wishPlace1
      .wishDate2 = .wishDate1
      .wishPlace1 = tmpData.wishPlace2
      .wishDate1 = tmpData.wishDate2
    End If
    'バブルソート3回目'
    If .wishDate2 > .wishDate3 Then
      tmpData = objData
      .wishPlace3 = .wishPlace2
      .wishDate3 = .wishDate2
      .wishPlace2 = tmpData.wishPlace3
      .wishDate2 = tmpData.wishDate3
    End If
  End With
End Sub

うーむ、我ながら吐き気を催すようなぶさいくなコードwww

いちおう、データ入れ替えのところだけ説明します。

バブルソート1回目」の部分、

'バブルソート1回目'
If .wishDate2 > .wishDate3 Then
  tmpData = objData    '……(1)'
  .wishPlace3 = .wishPlace2    '……(2)'
  .wishDate3 = .wishDate2    '……(3)'
  .wishPlace2 = tmpData.wishPlace3    '……(4)'
  .wishDate2 = tmpData.wishDate3    '……(5)'
End If

まず、2番目の日付と3番目の日付を比較して、2番目の方が大きかったら(1)以下で2番目の要素と3番目の要素を入れ替える。

(1)で元のデータをtmpDataに格納しておいて、
(2)、(3)で2番目だったデータを3番目のところに上書きし、
(4)、(5)でtmpDataに避難しておいたデータを用いて2番目のところに元々3番目だったデータを上書きする
という段取り。

構造体変数を引数にするときには、参照渡ししかできないみたいなので、Functionにする必要がなかった。

このプロシージャを呼び出して並べ替える。そのためのコードがコチラ。

リスト4
For i = 0 To 4
  Call sortDataByDate(wsData(i))
Next

これだけです。Forループで i 番目のwsDataを渡しています。

シートに書き出す

今回は、別の場所に転記先の表を作った。

リスト5
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
    'バブルソート1回目'
    If .wishDate2 > .wishDate3 Then
      tmpData = objData
      .wishPlace3 = .wishPlace2
      .wishDate3 = .wishDate2
      .wishPlace2 = tmpData.wishPlace3
      .wishDate2 = tmpData.wishDate3
    End If
    'バブルソート2回目'
    If .wishDate1 > .wishDate2 Then
      tmpData = objData
      .wishPlace2 = .wishPlace1
      .wishDate2 = .wishDate1
      .wishPlace1 = tmpData.wishPlace2
      .wishDate1 = tmpData.wishDate2
    End If
    'バブルソート3回目'
    If .wishDate2 > .wishDate3 Then
      tmpData = objData
      .wishPlace3 = .wishPlace2
      .wishDate3 = .wishDate2
      .wishPlace2 = tmpData.wishPlace3
      .wishDate2 = tmpData.wishDate3
    End If
  End With

End Sub

実行結果

実行前

f:id:akashi_keirin:20170604082519j:plain

実行後

f:id:akashi_keirin:20170604082529j:plain

ちゃんと日付順に整理された。

おわりに

うーん……。このままだとまるで応用が利かないなあ。

@akashi_keirin on Twitter