強引にセルを再計算させる
セルの再計算が通用しない場面に対応する
自作ワークシート関数
めちゃくちゃ条件分岐の多い、死ぬほどダルい表を作る必要があった。別に私の仕事でも何でもないんだけれど、泣きついて来られて仕方なく……。
自分の仕事でも何でもないから、仕事中にやるわけにも行かず、休みの日にやっている。もうお人好しのバカ過ぎて自分が嫌になるｗ
んで、アホみたいにややこしい数式を組む必要があってめんどくさかったので、
計算ロジックを全部隠蔽しちまって、簡単な関数にしちまえ！
と。まあ、そんなことをしたが最後、この仕事が延々私につきまといそうな嫌な予感もするんやが……。
ちゃっちゃと片付けてしまいたいので、自分のやりやすいようにやったｗ
後は野となれ、ですよ。こんなこと、人に頼るやつが悪いんですから。
困ったこと
ただ、一つ困ることがあった。自作したワークシート関数は、
行の中の２つのセルを引数として受け取って、計算した結果を返す関数
なんだが、計算の過程の中で、同じ行の別のセルの値を使うようになっている。
で、引数に指定したセルの値を変更したら、それに追随して返り値も変更されるが、計算の過程で用いる引数以外のセルを変更しても、返り値が変わらないのである。ま、当たり前なのだけれど。
……って、何のことか分からんな……。
ちょいと例を挙げてみよう。
こんな表があったとする。
んで、標準モジュールに、次のようなFunctionを作る。
リスト１ 標準モジュール
Public Function assembleWord(ByVal Cell1 As Range, _
ByVal Cell2 As Range) As String '……(1)'
Dim str As String
str = Cell1.Value & Cell2.Value '……(2)'
str = str & Cell2.Offset(0, 1).Value '……(3)'
assembleWord = str
End Function
説明するまでもないけれど、一応。
(1)では、引数にCell1とCell2の２つのセルを受け取るように設定。
(2)でCell1とCell2の値を連結して、
(3)でさらにCell2の右隣のセルの値を連結して返す、というアホみたいなFunction。
んで、こんなふうにＤ列のセルにこの自作関数を入力。
引数にＡ列のセルとＢ列のセルを指定。
無事、Ｄ列にＡ～Ｃ列の文字を連結した値が返された。
ところが、
こんなふうに、引数以外のＣ列のセルの値を変更しても、
Ｄ列の返り値は変化なし……。
もちろん、引数に指定しているたとえば、Ａ列の値を変更すると、
こんなふうに、変更が反映される。
つまり、Ｃ列を変更しても何も起こらず、Ａ列やＢ列を変更して初めてＣ列への変更がＤ列の返り値に反映される、ということ。これでは不便すぎる。
仕方がないので、
ワークシートのイベントで、セルの値が変更されたときに、自作ワークシート関数を書き込んだセルを再計算したらいいんじゃね？
と思い、再計算させたいセル（この場合はＤ２セル）にカーソルを置いて、イミディエイト・ウインドウに
Activecell.Calculate
としてみたが、ダメだった。ってことは、再計算させたいセルを指定してCalculateメソッドを実行してもダメだということだ。
強引な解決策
んで、強引な解決を考えた。
ワークシートのイベントを用いて、
自作関数の入ったセルから数式を一旦消して書き直す
という荒技ですよ！ グッヒッヒッ。
表のあるシートのモジュールに以下のコードを書く。
リスト２ シートモジュール
Private Sub Worksheet_Change(ByVal Target As Range)
With Target '……(1)'
If .Column < 3 Then Exit Sub
If .Column > 4 Then Exit Sub
If .Row < 2 Then Exit Sub
If .Row > 6 Then Exit Sub
End With
Dim targetRow As Integer
targetRow = Target.Row
Application.EnableEvents = False
Dim Sh As Worksheet
Set Sh = Target.Parent
Dim str As String
With Sh.Range("D" & targetRow) '……(2)'
str = .Formula
.Formula = ""
.Formula = str
End With
Application.EnableEvents = True
End Sub
まず、(1)からの６行はガード節。今回、変更に対応しないといけないのはＣ列の２～６行目だけなので、それ以外の箇所が変更されたときには何もせずに処理を抜けるようにした。
後は、見ての通り。
(2)の
With Sh.Range("D" & targetRow)
str = .Formula
.Formula = ""
.Formula = str
End With
がポイント。自作ワークシート関数を書き込んだＤ列について、一旦数式文字列を変数strにぶち込んでから、数式を削除し、改めてstrにぶち込んでおいた数式を書き込み直している。
実行結果
Ｃ列をこんなふうに変更して、[Enter]をポチッ！
ほれ、再計算された返り値がＤ列に返っている。
おわりに
しっかし、いかにも強引な解決方法で、美しくないんだよなあ。まあ、計算に使うセルは全て引数に指定しろよ、ってことなのかも知れん。
連想配列（Scripting.Dictionaryオブジェクト）というものを使ってみた
初めての連想配列
「連想配列」とか、「Dictionary」という言葉は見たことがあったけれど、使ったこともなく、詳しく知ることもなかった。
自作クラスのエラーメッセージを管理するのがメンドクサイなーと思って、「そういえば……」とちょっと調べてみると、
便利かも
と思ったので、ちょいとやってみた。
Scripting.Dictionaryオブジェクトを使う
CreateObject関数がちょっと嫌いというか、New演算子が好きなので（←意味不明）、VBEの[ツール]→[参照設定]で、
Microsoft Scripting Runtime
にチェックを入れる。
ひとまず、準備はこれでおｋ。
Dictionaryオブジェクトの作成
今のところイメージしている使いどころとしては、文字通りの「辞書」みたいな使い方なので、
静的に定義したDictionaryオブジェクトを返すFunction
というイメージでやってみる。
リスト１ 標準モジュール
Public Function createMessageDictionary() As Scripting.Dictionary '……(1)'
Dim messageDictionary As Scripting.Dictionary '……(2)'
Set messageDictionary = New Scripting.Dictionary
With messageDictionary '……(3)'
.Add Key:=10001, _
Item:="ち～んｗ" '……(*)'
.Add Key:=10002, _
Item:="プヒー！"
.Add Key:=10003, _
Item:="( ´,_ゝ｀)ﾌﾟｯ"
.Add Key:=10004, _
Item:="( ´_ゝ｀)ﾌｰﾝ"
End With
Set createMessageDictionary = messageDictionary '……(4)'
End Function
まず、(1)の
Public Function createMessageDictionary() As Scripting.Dictionary
静的に定義したDictionaryを返す、という体なので、引数はなし。参照設定済みなので、返り値の型には「Scripting.Dictionary型」を指定。「Object型」とかはあんまり使いたくないなあ。
(2)からの２行
Dim messageDictionary As Scripting.Dictionary Set messageDictionary = New Scripting.Dictionary
Scripting.Dictionary型の変数messageDictionaryを宣言し、インスタンス化。
やっぱり、Newを使う方が「インスタンス化したった」感が出て好きだなあ。
(3)からの10行（実質６行）
With messageDictionary
.Add Key:=10001, _
Item:="ち～んｗ" '……(*)'
.Add Key:=10002, _
Item:="プヒー！"
.Add Key:=10003, _
Item:="( ´,_ゝ｀)ﾌﾟｯ"
.Add Key:=10004, _
Item:="( ´_ゝ｀)ﾌｰﾝ"
End With
では、DictionaryオブジェクトのAddメソッドを用いて要素を追加。
KeyとItemをセットで追加している。
このあたり、Collectionオブジェクトとか、VBAだとユーザーフォームのリストボックスなんかの扱いに似ているので、脱初級ぐらいのレベルで十分理解可能ですね。
あとは、(4)の
Set createMessageDictionary = messageDictionary
で、できあがったDictionaryオブジェクト（messageDictionary）を返り値にセットしておしまい。
使用実験
標準モジュールに次のコードを書いて使ってみる。
リスト２ 標準モジュール
Public Sub testmessageDictionary()
Dim msgDic As Scripting.Dictionary '……(1)'
Set msgDic = createMessageDictionary()
Dim i As Integer
For i = 10001 To 10004 '……(2)'
Debug.Print msgDic.Item(i)
Next
End Sub
(1)からの
Dim msgDic As Scripting.Dictionary Set msgDic = createMessageDictionary()
では、Scripting.Dictionaryオブジェクトのインスタンス用の変数msgDicを宣言して、createMessageDictionaryメソッドを用いてインスタンスを作成し、ぶち込んでいる。
あとは、(2)からの３行
For i = 10001 To 10004 Debug.Print msgDic.Item(i) Next
でForループを用いてイミディエイト・ウインドウに出力する。
実行結果
こんなふうに、無事取得できた。
おわりに
これはこれで、使いようによっては便利だと思うので、研究したいね。
Excelの場合は、ワークシートをDictionaryのように使う方が圧倒的にラクなので、ついそれに甘えてしまうけれど、通常のプログラミングのことを考えたら、こういういろいろなデータ構造の扱い方を覚えていかないとなー。
Application.GetPhoneticが壊れた？？？
GetPhonetic関数がおかしい？？？
GetPhonetic関数の異状
Application.GetPhonetic関数は、２回目以降引数を省略すると、まだ返していないふりがな文字列を返すはず。
しかしながら、何か様子がおかしいのである。
たとえば、次のコード。
リスト１ 標準モジュール
Public Sub testGetPhonetic()
Debug.Print Application.GetPhonetic("馬") '……(1)'
Debug.Print Application.GetPhonetic() '……(2)'
End Sub
アホみたいなコードだけれど、これを実行すると、(1)を実行したとき（１回目）に「ウマ」が出て、(2)を実行したとき（２回目）に「マ」とかが出るはず。
だのに、なぜか今の私の環境だと
こうなる。
(2)のGetPhoneticが "" を返しているっぽい。これは、漢字を別のに変えても同じ。１つしかふりがなを返してくれない。
一応、Officeの修復もしてみたんだけれどダメ。いったい何が起きているんだろう？？？
追記
Dir関数で実験してみると、ちゃんと
Dir()
で次の返り値を返してくれている。マジでわけがわからないよ……orz
さらに追記
ちなみに、
Public Sub testGetPhonetic()
Debug.Print Application.GetPhonetic("馬")
Debug.Print Application.GetPhonetic()
Debug.Print Application.GetPhonetic()
Debug.Print Application.GetPhonetic()
Debug.Print "＊＊＊ち～んｗ＊＊＊"
End Sub
を実行すると、
こうなる。
やっぱり、２回目以降のGetPhonetic()は、空文字を返している。
ちなみに、最後に
Debug.Print Asc(Application.GetPhonetic())
を加えて実行すると、
となるので、本当に "" が返っているみたい。
なんでこうなってしまったんだーーー！
VBAの「コンストラクタに引数渡せない」問題
VBAの「コンストラクタに引数を渡せない」問題
VBAでクラスモジュールを使い始めたときに必ずぶち当たるのが、
なんでコンストラクタに引数が渡せねえんだよ！
この金髪豚野郎!!!!!!!!!
問題だろう。（個人の感想です）
これは本当に不便な話で、「VBAのイマイチなところ大特集」でもやったら、かなり上位に来る項目だと思う。
よくあるやり方は、別途initメソッドを持たせておいて、Newしたら必ずセットでinitメソッドも実行する、というもの。これは自分でもよくやる。
initメソッド未実行ならば、一切メソッドの実行もプロパティの参照もさせないようにしておくことで、まあそこそこの信頼性は確保できる。
こんな感じ。まあ、このときはinitメソッド実行済みチェックが不完全ですなあ。ははは。
達人の方なんかだと
VBA 自分と同じクラスの新規オブジェクトを返すメソッドを作ってコレクションにスマートに代入する
みたいに、すげえやり方で実装していたりする。
私はなにぶんにも素人なので、もっとアホみたいな対応策を考えてみた。
インスタンス作成用Function
CreateObject関数みたいな感じのFunctionを作って、Newさせずにインスタンスを得る、という方向で考えた。
リスト１ 標準モジュールの宣言セクション
まずは、準備として標準モジュールの宣言セクションに次のコードを書く。
Public Enum RacerClass SS = 0 S1 S2 S3 A1 A2 A3 A4 B1 B2 End Enum Public isInstantiated As Boolean
列挙体とPublic変数の宣言をしているだけ。先に書くと、Public変数を使う、という点が今回の対応のイマイチなところだという自覚はあるｗ
リスト２ クラスモジュール
クラスモジュールを挿入し、オブジェクト名を「SampleRacer」とした。
Option Explicit Private Const ERROR_MESSAGE_10001 As String = _ "SampleRacerクラスを直接Newすることはできません。" & vbCrLf & _ "createSampleRacerObjectメソッドを使用してインスタンス化してください。" Private Const ERROR_MESSAGE_10002 As String = _ "initメソッドを複数回実行することはできません。" Private registeredName_ As String Private racingClass_ As RacerClass Private graduatedTerm_ As Integer Private isInitialized As Boolean Public Property Get registeredName() As String registeredName = registeredName_ End Property Public Property Get racingClass() As String Select Case racingClass_ Case RacerClass.SS racingClass = "Ｓ級Ｓ班" Case RacerClass.S1 racingClass = "Ｓ級１班" Case RacerClass.S2 racingClass = "Ｓ級２班" Case RacerClass.S3 racingClass = "Ｓ級３班" Case RacerClass.A1 racingClass = "Ａ級１班" Case RacerClass.A2 racingClass = "Ａ級２班" Case RacerClass.A3 racingClass = "Ａ級３班" Case RacerClass.A4 racingClass = "Ａ級４班" Case RacerClass.B1 racingClass = "Ｂ級１班" Case RacerClass.B2 racingClass = "Ｂ級２班" End Select End Property Public Property Get graduatedTerm() As Integer graduatedTerm = graduatedTerm_ End Property Private Sub Class_Initialize() '……(1)' If Not isInstantiated Then _ Err.Raise Number:=10001, _ Description:=ERROR_MESSAGE_10001 isInstantiated = False End Sub Public Sub init(ByVal racerName As String, _ ByVal racingClass As RacerClass, _ ByVal graduatedTerm As Integer) '……(2)' If isInitialized Then Err.Raise Number:=10002, _ Description:=ERROR_MESSAGE_10002 Call setRacer(racerName, racingClass, graduatedTerm) isInitialized = True End Sub Public Sub setRacer(ByVal racerName As String, _ ByVal racingClass As RacerClass, _ ByVal graduatedTerm As Integer) Call setName(racerName) Call setClass(racingClass) Call setTerm(graduatedTerm) End Sub Public Sub setName(ByVal racerName As String) registeredName_ = racerName End Sub Public Sub setClass(ByVal racingClass As RacerClass) racingClass_ = racingClass End Sub Public Sub setTerm(ByVal graduatedTerm As Integer) graduatedTerm_ = graduatedTerm End Sub Public Sub showMyself() Debug.Print "ハロ～♪ ＣＱ、ＣＱ、私は" & Me.racingClass & "。" Debug.Print graduatedTerm_ & "期の" & registeredName & "で～す！" End Sub
サンプルだから凝らなくてもいいのに、ムダにタテ長になってしまった。いつものことながら申しわけない。
ごく普通のクラスモジュールだが、(1)の
Private Sub Class_Initialize()
If Not isInstantiated Then _
Err.Raise Number:=10001, _
Description:=ERROR_MESSAGE_10001
isInstantiated = False
End Sub
では、普段ほぼ何の役にも立たないClass_Initializedプロシージャに
If Not isInstantiated Then
という条件式を書いている。isInstantiatedという変数については後述するが、普通にNewでインスタンス化しようとすると、ここでエラーを吐いて弾き返す、という仕組みにした。
最後に
isInstantiated = False
でisInitializedをFalseに戻す。こうしておかないと、次から普通にNewできてしまうｗ Function作った意味がなくなるので、要注意。
あと、(2)の
Public Sub init(ByVal racerName As String, _
ByVal racingClass As RacerClass, _
ByVal graduatedTerm As Integer)
If isInitialized Then Err.Raise Number:=10002, _
Description:=ERROR_MESSAGE_10002
Call setRacer(racerName, racingClass, graduatedTerm)
isInitialized = True
End Sub
が実質的なコンストラクタ。isInitializedフラグを用いることで複数回実行されることを防ぐ。
リスト３ 標準モジュール
んで、コチラがインスタンス生成用のFunction。
Public Function createSampleRacerObject( _
ByVal racerName As String, _
ByVal racingClass As RacerClass, _
ByVal graduatedTerm As Integer) As SampleRacer
isInstantiated = True '……(1)'
Dim smplRacer As New SampleRacer '……(2)'
smplRacer.init racerName, racingClass, graduatedTerm '……(3)'
Set createSampleRacerObject = smplRacer '……(4)'
End Function
シンプルなコードなので説明するまでもないけれど、一応。
まず、(1)の
isInstantiated = True
でisInstantiatedをTrueにしておく。こうすることで、次に(2)でNewしたときにClass_Initializedで弾き返されることを防ぐ。
(2)の
Dim smplRacer As New SampleRacer
でインスタンス化し、
(3)の
smplRacer.init racerName, racingClass, graduatedTerm
で引数を渡して初期化。
あとは、(4)の
Set createSampleRacerObject = smplRacer
でインスタンスを呼び出し元に返す。
使用実験
次のコードでSampleRacerクラスを使ってみる。
リスト４ 標準モジュール
Public Sub testSampleRacerClass()
Dim sr1 As SampleRacer
Set sr1 = New SampleRacer '……(*)'
Set sr1 = createSampleRacerObject("中野浩一", S1, 35) '……(1)'
With sr1
.showMyself '……(2)'
.setRacer "左京源皇", A3, 72 '……(3)'
.showMyself
.setRacer "鶴岡篤人", B2, 52 '……(4)'
.showMyself
End With
Dim sr2 As SampleRacer
Set sr2 = createSampleRacerObject("吉岡稔真", S1, 65) '……(5)'
sr2.showMyself
End Sub
まず、このまま実行してみると、一見何の問題もなさそうな(*)の
Set sr1 = New SampleRacer
のところで、
エラーになる。狙い通り。
実行時は(*)をコメントアウトします。
(1)の
Set sr1 = createSampleRacerObject("中野浩一", S1, 35)
でcreateSampleRacerObjectに引数を３つ渡してインスタンス化。
(2)の
sr1.showMyself
でshowMyselfメソッドを実行。
(3)からの２行
sr1.setRacer "左京源皇", A3, 72 sr1.showMyself
では、setRacerメソッドでパラメータを書き換えた後、showMyselfメソッドを実行。
(3)からの２行
sr1.setRacer "鶴岡篤人", B2, 52 sr1.showMyself
も(2)と同じ。
(5)からの２行
Set sr2 = createSampleRacerObject("吉岡稔真", S1, 65)
sr2.showMyself
では、別のインスタンスを生成してshowMyselfメソッドを実行。
実行結果
無事、意図したとおりの結果となった。
おわりに
今にして思えば、別にNewを禁止することはなかったな。
引数が必要なければ普通にNew、引数が必要だったらFunction経由、という風に使い分けたらいいだけだし。
そうすれば、グローバル変数isInstantiatedも必要なくなるなあ。
インターフェイスを使うやり方も含め、もうちょっと研究してみる余地はありそう。
OutLookメール自動作成メソッド
メール自動作成ツール～Outlookへの対応
このとき
作成したメール自動作成ツール、LotusNotes、Thunderbirdの両方に対応していて非常に便利なので、重宝している。
で、せっかくなのでOutlookにも対応させてみようと思い、ちょっとやってみた。
前に作成したクラスに、Outlookメール作成メソッドを追加する。
参考：今回使用する自作クラスのプロパティ一覧
| プロパティ | 型 | 説明 |
|---|---|---|
| mailTo | String | 宛先のメールアドレス |
| CC | String | CCアドレス |
| BCC | String | BCCアドレス |
| mailSubject | String | メールの件名 |
| belongsTo | String | 名宛て人の所属 |
| jobTitle | String | 名宛て人の肩書 |
| personName | String | 名宛て人の名前 |
| returnReceipt | String | 受信確認の有無 |
| mailBody | String | メール本文 |
| attFiles | String | 添付ファイルフルパス |
| senderData | String | 送信人のデータ |
| numOfBody | Integer | 本文の段落数 |
| numOfAttFiles | Integer | 添付ファイル数 |
| numOfSenderData | Integer | 送信人データの行数 |
今にして思えば、最後の３つとか、クラスの外部に公開する意味ないなー。
Outlookに対応する
createOutlookMailというメソッド名にした。
メソッドのコードを載せる。
Public Sub createOutlookMail() On Error Resume Next Err.Clear Dim objOutlook As Outlook.Application Set objOutlook = GetObject(, "Outlook.Application") '……(1)' If objOutlook Is Nothing Then _ makeUserSick "Outlookが起動してないしｗｗｗ": End '……(2)' '本文文字列の作成' '左肩部分の作成' Dim strAddressee As String strAddressee = belongsTo_ & vbCrLf & " " & _ jobTitle_ & " " & _ personName_ & " 様" & _ vbCrLf & vbCrLf & vbCrLf '……(3)' '本文をstrBodyに連結していく' Dim strBody As String Dim i As Integer For i = 1 To numOfBody '……(4)' strBody = strBody & mailBody_(i) & vbCrLf & vbCrLf Next Dim objMailItem As MailItem Set objMailItem = objOutlook.CreateItem(olMailItem) '……(5)' With objMailItem 'デフォルトの署名文字列を取得するために一旦RichText形式にする ……(6)' .BodyFormat = olFormatRichText .Display 'この時点ではBodyプロパティには署名文字列しか入っていないので、' '署名文字列を変数に入れる。' Dim signatureString signatureString = .Body 'ここでHTML形式に変える' .BodyFormat = olFormatHTML .To = mailTo '……(7)' .CC = CC_ .BCC = BCC_ .Subject = mailSubject_ '左肩、本文、署名の順にBodyプロパティに書き込む' .Body = strAddressee & _ strBody & vbCrLf & vbCrLf & _ signatureString '添付ファイルの設定' If numOfAttFiles_ <> 0 Then For i = 1 To numOfAttFiles_ .Attachments.Add attFiles_(i) Next End If End With If Err.Number > 0 Then Call errorCatch("MailDataクラスのcreateOutlookMailメソッド", _ Err.Number, _ Err.Description) MsgBox "【Main】シートへの入力に不備がなかったか、確認してやり直してください。", _ vbCritical End If On Error GoTo 0 End Sub
ちょい長くなってしまったけれど、単にメールを作るだけならそんなに難しいとは感じなかった。
まず、(1)の
Set objOutlook = GetObject(, "Outlook.Application")
で現在起動中のOutlookアプリケーションオブジェクトを取得。
(2)の
If objOutlook Is Nothing Then _
makeUserSick "Outlookが起動してないしｗｗｗ": End
では、Outlookが起動していなかったらobjOutlookがNothingになるはずなので、ユーザーを煽って処理自体を終了。
makeUserSickは、もちろんこのときのやつですｗ
いきなりEndで終わるなんて、何か投げやりな対応なので、今後詰めていく必要がありそう。
(3)の
strAddressee = belongsTo_ & vbCrLf & " " & _
jobTitle_ & " " & _
personName_ & " 様" & _
vbCrLf & vbCrLf & vbCrLf
では、本文の宛名の部分の文字列を作成。まあ、別に本文と分離する必要はないかなあとも思ったんだが、一応、別々にしといた。
(4)の
For i = 1 To numOfBody_ '……(4)' strBody = strBody & mailBody_(i) & vbCrLf & vbCrLf Next
では、本文を段落ごとに格納した内部配列mailBody_()から要素を取り出してきて、改行コードとともに連結している。
ここまでで、本文の左肩部分と本文がそれぞれひとかたまりの文字列になっている。
ここからがOutlook側の処理。
まず、(5)の
Set objMailItem = objOutlook.CreateItem(olMailItem)
でMailItemオブジェクトをインスタンス化する。
まだイマイチMailItemオブジェクトって何者なのかよく分かっていない。
MailItems.Add とかだと理解しやすいんだけれど、どうもそういうオブジェクトモデルではないらしい。
んで、(6)からの５行（コメント除く）がちょっとめんどくさい。
'デフォルトの署名文字列を取得するために一旦RichText形式にする' .BodyFormat = olFormatRichText .Display 'この時点ではBodyプロパティには署名文字列しか入っていないので、' '署名文字列を変数に入れる。' Dim signatureString signatureString = .Body 'ここでHTML形式に変える' .BodyFormat = olFormatHTML
手順としては、
RichText形式を指定→新規メールを表示→署名文字列を変数に格納→HTML形式に変換
という形。
なんでこんなに面倒なことをしているのかというと、
はじめからHTML形式を指定するとデフォルトの署名が書き込まれない
から。このあたりの挙動は、そもそもOutlookの設定でなんとかなるかも知れない。Outlookは今まで使ったことがなかったのでよく分かっていないのです。
まあ、ここまででメール本体を作り上げる準備ができたことになるので、あとは(7)からの12行（実質10行。コメント除く）
.To = mailTo .CC = CC_ .BCC = BCC_ .Subject = mailSubject_ '左肩、本文、署名の順にBodyプロパティに書き込む' .Body = strAddressee & _ strBody & vbCrLf & vbCrLf & _ signatureString '添付ファイルの設定' If numOfAttFiles_ <> 0 Then For i = 1 To numOfAttFiles_ .Attachments.Add attFiles_(i) Next End If
で一気に必要事項を書き込んでおしまい。
準備
まず、Outlookの[ファイル]メニューから[オプション]→[メール]へと進み、[署名]ボタンをクリックして、
こんなふうに署名を作成した。
実行
クラスをインスタンス化してcreateOutlookMailメソッドを実行してみると、
一応、メールは無事に作成された。
おわりに
まだイマイチOutlookのオブジェクトモデルが理解できていないので、全然ダメダメですね。
フォントを変えたり、文字の大きさを変えたり、といったことも盛り込んで行かないと、現状めちゃくちゃ読みづらい見た目のメールになってしまうのが大きな課題です。
しっかし、初心者のころに作ったクラスだけあって、イマイチな設計やなあ……。
がんばれ！ isKanjiメソッドくん!!!!!!!!
文字列から漢字のみ抽出する
isKanjiメソッドを強引に使う
前回
作成したisKanjiメソッドの使いどころを無理矢理発明した。
準備
まず、
こんな風にシートを作っておいて、Ａ１セルに「TextCell」、Ｃ２セルに「BaseCell」と名前を定義しておく。ちなみに、シートには「Main」と名前を付けている。
んで、コマンドボタンを押したら、Ｃ２セルから下にずらーっとＡ１セルの文字列から漢字だけを抽出して１列に並べる。
ついでに、Ｄ列にはそれぞれの漢字の読みも書き込んでしまおう。
もちろん、何の役に立つのかは分からない。諸君が自分で考えてくれたまえ。これは役に立つツール類の紹介ではなくて、私自身の勉強なのだ。
コーディング
とりあえず、コードを載っけてしまおう。
リスト１ 標準モジュール
Public Sub pickOutAndOrderKanji()
Dim Sh As Worksheet
Set Sh = ThisWorkbook.Worksheets("Main")
Dim textCell As Range
Set textCell = Sh.Range("TextCell")
Dim baseCell As Range
Set baseCell = Sh.Range("BaseCell")
baseCell.CurrentRegion.ClearContents
Dim wholeString As String
wholeString = textCell.Value
If Len(wholeString) < 1 Then _
makeUserSick ("文字がないやんけぼけー！"): Exit Sub '……(1)'
Dim i As Integer
Dim n As Integer
Dim targetChar As String
Dim tmp As String
n = 0
For i = 1 To Len(wholeString) '……(2)'
targetChar = Mid(wholeString, i, 1) '……(3)'
If isKanji(targetChar) Then '……(4)'
With baseCell
.Offset(n, 0).Value = targetChar '……(5)'
tmp = Application.GetPhonetic(targetChar) '……(6)'
tmp = StrConv(tmp, vbHiragana)
.Offset(n, 1).Value = tmp
End With
n = n + 1 '……(7)'
End If
Next
End Sub
出だしの７行は、「Main」シートやら文字列の入ったセルやら基準になるセルなんかを変数にぶち込んだり、前回の書き込みを削除したり、といった処理。
んで、準備ができたら、まず(1)の
If Len(wholeString) < 1 Then _
makeUserSick ("文字がないやんけぼけー！"): Exit Sub
で処理対象文字列を調べる。文字数が0だったらそもそも処理する意味がないので、ここで終了。ちなみに、makeUserSickメソッドというのは、このとき作成したもの。
ここからが処理の中心。(2)からのForループでは、
For i = 1 To Len(wholeString)
開始・終了条件をこのように設定。１文字目から最終文字目までをループ処理する。
んで、Forブロックの中身へ。
(3)の
targetChar = Mid(wholeString, i, 1)
では、Mid関数を使って１文字を切り出し、変数targetCharにぶち込む。
(4)の
If isKanji(targetChar) Then
では、このとき作成したisKanjiメソッドでtargetCharの中身が漢字かどうかを判定。True、すなわち漢字だったら以下の処理を行う。
まず(5)。
.Offset(n, 0).Value = targetChar
Ｃ列に文字を書き込む。isKanjiメソッドがTrueを返しているのだから、漢字が書き込まれることになる。
で、(6)からの３行。
tmp = Application.GetPhonetic(targetChar) tmp = StrConv(tmp, vbHiragana) .Offset(n, 1).Value = tmp
まず、
tmp = Application.GetPhonetic(targetChar)
Application.GetPhoneticメソッドを用いて、読み仮名を変数tmpにぶち込む。ただ、この時点ではtmpの中身はカタカナなので、次の
tmp = StrConv(tmp, vbHiragana)
でStrConv関数を用いて平仮名に変えてtmpにぶち込む。
最後に
.Offset(n, 1).Value = tmp
でＤ２セルから数えて上から n 番目（開始は0）のセルにtmpの中身を書き込む。
最後に(7)の
n = n + 1
で n をインクリメントする。
実行結果
上掲のpickOutAndOrderKanjiメソッドをコマンドボタンに登録し、ボタンクリックで実行してみる。
ちなみに、Ａ１セルに入っている文字列は、
お前はアホか。アホちゃいまんねん、馬鹿ですねん。競輪は日本の国技です。「C#（シーシャープ）」は、完全にオブジェクト指向プログラミング（ＯＯＰ）のための言語です。こう書くと何か難しい言語のような感じを受けるかも知れませんが、心配はいりません。オブジェクト指向プログラミングでは、難しいことは全部カプセル化し、プログラマはその恩恵を受けるだけなのです。
というものとする。
ほい。この通り、うまく行って……
ない!!!!!!!!
orz
よく見ると、11行目、もともと「C」（半角アルファベットの"C"）、「#」（半角記号の"#"）だったところが、漢字でもないのに出力されてしまっている。これが、このとき申し上げたisKanjiメソッドの致命的な欠陥です。
何がイカンのか
原因は非常にカンタン。
たとえば、１バイト文字の文字コード「DF」（半角カタカナの半濁点"ﾟ"）を調べてみる。
10進数に直すと「223」、つまり、正の数なんである。
このとき、漢字かどうかの判定をどうしていたか。
Asc(char) >= &H889F
こんな条件式で判定していたのである。
２バイト文字の文字コードは全て負の数だったので、こんな条件式では当然１バイト文字は全てTrueになってしまうのである。
コードの修正
そこで、isKanjiメソッドのコードを以下のように修正する。
リスト２ 標準モジュール
Public Function isKanji(ByVal targetCharacter As String) As Boolean
Dim char As String
char = targetCharacter
If Len(char) <> 1 Then Err.Raise Number:=10001, _
Description:="引数は1文字のみにしてください。"
If Asc(char) > 0 Then isKanji = False: Exit Function '……(*)'
If Asc(char) >= &H889F Then
isKanji = True
Else
isKanji = False
End If
End Function
付け加えたのは(*)の
If Asc(char) > 0 Then isKanji = False: Exit Function
だけ。要するに、文字コードが正の数だったら即Falseを返してFunctionを抜けるようにしているだけ。
テスト
生まれ変わったisKanjiメソッドをテストしてみる。
イミディエイト・ウインドウで
?isKanji("F")
を始めいろいろな１バイト文字を引数にしてisKanjiメソッドを実行してみると、
ほれ、ちゃんと期待したとおりの結果が出ている。
おわりに
これで一件落着、めでたしめでたし……と思いきや、
orz
わがisKanjiメソッドの運命やいかに！（続きません）
文字が漢字かどうかを判定するFunction
文字が漢字かどうかを判定するFunction
漢字かどうかの判定
文字が漢字かどうかを判定するロジックを考えた。
画像の出典はコチラのサイトっす。
Shift_JISの文字コード表を見ると、漢字は 889F以降に割り当てられているっぽい。
16進数の889Fってのは、
この通り、10進数だと-30561。
んで、次の88A0は
この通り、10進数だと-30560になる。
ということは、文字コードが889F、すなわち-30561以上だったら漢字ということだ。
コーディング
以上を踏まえてコーディングする。
リスト１ 標準モジュール
Public Function isKanji(ByVal targetCharacter As String) As Boolean
Dim char As String
char = targetCharacter '……(1)'
If Len(char) <> 1 Then _
Err.Raise Number:=10001, _
Description:="引数は1文字のみにしてください。" '……(2)'
If Asc(char) >= &H889F Then '……(3)'
isKanji = True
Else
isKanji = False
End If
End Function
(1)の
char = targetCharacter
では、引数targetCharacterで受け取った文字（列）を変数charにぶち込んでいる。別にこんなことしなくても良いのだけれど、引数名を「targetCharacter」と長い名前にしたので、そのまま使ったら１行が長くなるから。ただそれだけのこと。自作関数やメソッドの引数名をなるべく説明的に付けようと最近決心しただけです。
(2)の３行（実質１行）
If Len(char) <> 1 Then _
Err.Raise Number:=10001, _
Description:="引数は1文字のみにしてください。"
はガード節。そもそも１文字について漢字かどうか判定したいので、引数に複数文字の文字列を与えられたら困る。だからエラーを吐く仕様にした。
いつも、自作エラーの番号は10001とかテキトーかつ投げやりな番号にしているんだけれど、こういうのもコーディング規約的に決めておいたほうがいいんですかね？
メインの処理は(3)からの５行
If Asc(char) >= &H889F Then isKanji = True Else isKanji = False End If
Asc関数で文字コードの数字が得られるので、それを16進数の889Fと比較して、889F以上だったらTrue、未満だったらFalseを返すようにした。
実行結果
イミディエイト・ウインドウで
?isKanji("亜")
など、文字コード表先頭の漢字「亜」を皮切りにいくつかの２バイト文字を引数にしてisKanjiメソッドを実行してみた結果が
コチラ。
ちゃんと期待した結果が得られた。
おわりに
ただ、コンピュータに詳しい人なら一瞬で気づいたと思いますけど、このFunctionには少なくとも１つ、重大な欠陥があるのです。そのあたりは次回……。
でも、そんなことはともかく、このFunctionの使いどころって、何なのでしょうねえ……？
追記
ちなみに、上記の「重大な欠陥」は、
コチラで修正してあります。
