FileSystemObjectによるファイル取り出しの順序
FileSystemObjectによるファイル取り出しの順序
おなじみ、OFFICE TANAKAのコチラのページによると、「
」は、Dir
関数が返すファイルの順番
ディスクのフォーマットによって異なります。最近主流のNTFSでフォーマットされているディスクでは、ファイルが保存された順番(タイムスタンプ)にかかわらず、ファイル名の順番(昇順)で返ります。
ということらしい。また、
FATと呼ばれる形式でフォーマットでされたディスクでは、ファイル名の順番ではなく、ディスクに保存された順番で返ります。
とも。
では、FileSystemObject
のFiles
コレクションをFor ~ Each
で回した場合はどうなるのか。
やってみた。
準備
まずは、Sample
というフォルダを作り、その中にテキストファイルを作った。
で、そのSample
フォルダを、フラッシュメモリ(FAT32)上とHDD(NTFS)上に置いた。
ファイルを取り出す
ファイルを取り出して、ファイル名を書き出すコードを次のように書いた。
リスト1 標準モジュール
Private Sub printFilenames(ByVal tgtDir As String) If fsObj Is Nothing Then _ Set fsObj = New FileSystemObject Dim tgtFolder As Folder Set tgtFolder = fsObj.GetFolder(tgtDir) Dim txtFiles As Collection Set txtFiles = New Collection Dim txtFile As File For Each txtFile In tgtFolder.Files Call txtFiles.Add(txtFile) Next Dim i As Long For i = 1 To txtFiles.Count Debug.Print txtFiles(i).Name Next End Sub
変数fsObj
はモジュールレベルで宣言してある。
で、これを次のコードで呼び出して実行する。
リスト2 標準モジュール
Private Sub testPrintFilenames() Dim tgtDir As String 'フラッシュメモリ(FAT32)上のフォルダ' tgtDir = ThisWorkbook.Path & "\Sample\" Debug.Print "### FAT32からのファイル名取り出し ###" Call printFilenames(tgtDir) 'HDD(NTFS)上のフォルダ' tgtDir = "D:\Sample\" Debug.Print "### NTFSからのファイル名取り出し ###" Call printFilenames(tgtDir) End Sub
実行結果
ご覧の通り。
おわりに
確かに、ファイルシステムによって取り出し順は異なるようだ。
引数二つのProperty
引数二つのProperty
前回
作成したCaptionBox
クラス。
テキストボックスの塗りつぶし色と透過性という基本的なセッティングをするのに、たとえば
With captBox.Fill .ForeColor.RGB = vbBlack .Transparency = 0.4 End With
と書かねばならず、イマイチだなあと思っていた。
色と透過性をいっぺんに設定できないものか、と思ってやってみた。
Property Letを使ってみる
設定だけできたらいいので、書き込み専用のProperty、すなわち、Property Letでいいんでねえか、と思って作ってみた。
リスト1 クラスモジュール CaptionBox
Public Property Let BackColor( _ ByVal colorConstant As Long, _ ByVal transparencyRatio As Single) With captBox_.Fill .ForeColor.RGB = colorConstant .Transparency = transparencyRatio End With End Property
引数を二つ受け取って、それぞれ[Shape].Fill.ForeColor.RGB
プロパティと[Shape].Fill.Transparency
の値をセットするだけ。
問題は使い方。
通常、Propertyをセットするときは、
[オブジェクト式].[プロパティ] = [値]
という形で値をプロパティに渡す。
今回のように、引数が二つあるときはどうするのか。
次のようにするのである。
使ってみる
さっそく、新設のBackColor
プロパティを使ってみよう。
リスト2 標準モジュール
Private Sub testAddTextBox() Dim Sld As Slide Set Sld = ActivePresentation.Slides(1) Dim captBox As CaptionBox Set captBox = insertCaption(Sld, "ち~んw", True) '……(1)' captBox.BackColor(vbBack) = 0.4 '……(2)' captBox.TextFrame.HorizontalAnchor = msoAnchorCenter '……(3)' End Sub Private Function insertCaption( _ ByVal targetSlide As PowerPoint.Slide, _ ByVal captString As String, _ Optional ByVal isBottom As Boolean = False) As CaptionBox Dim ret As CaptionBox Set ret = New CaptionBox Call ret.init(targetSlide, captString) If isBottom Then Call ret.flipHorizontally Set insertCaption = ret End Function
(1)で、insertCaption
メソッドを実行してテキストボックスを一つ目のスライドに設置する。
insertCaption
メソッドの返り値はCaptionBox
クラスのインスタンスなので、設置したテキストボックスは、返り値のインスタンスを通じてあれこれ操作できる。
(2)の
captBox.BackColor(vbBack) = 0.4
が今回のキモ。
BackColor
プロパティの第1引数は、まさにBackColor
プロパティの引数であるかのようにカッコにいれる。で、第2引数を代入演算子(=
)を用いて設定する。
これで、テキストボックスの塗りつぶし色が黒、透過性が40%になる。
あとは、(3)でテキストのヨコ方向の位置を中央揃えにしておしまい。
実行結果
この状態でリスト2を実行すると、
このとおり。
おわりに
問題は、(2)の入力方法がわかりやすいかどうか、だと思う。
入力中に表示されるヒントは
こんな感じ。
Property Letに二つ以上の引数を持たせるのはアリかナシか……。
使用時のコーディングはちょっとわづらわしくなるとはいえ、素直にBackColor
プロパティとTransparency
プロパティの二つを持たせて、
captBox.BackColor = vbBlack captBox.Transparency = 0.4
と書く方がわかりやすいかも知れない。
PowerPointのスライドにキャプションを置く
PowerPointのスライドにキャプションを置くクラス
PowerPoint初心者です。仕事でもほとんど使う機会がなかったので、そこらへんの素人以下です。
スライドショー的なPresentation
そんなPowerPointど素人の私が、画像中心のPresentationを作ることになった。
百枚近くある写真を次々に見せていくだけのもの。
そもそもPowerPointでやるのがふさわしいのかどうかもよくわからん。その程度にはIT音痴の私。
写真を貼り付けるのはマクロで瞬殺したものの、キャプションを入れるのがめんどくさい……。
そこで、PowerPointVBA入門を兼ねて、スライドにキャプションを入れるマクロを作った。
キャプション的なものを入れるのは、今後も使い回せそう……しかしながら、フォントとかマージンとか寸法とか位置決めとか、設定項目がやたらたくさんあるので、クラスにしておいたら便利ではないかと思った。
望ましいソリューションなのかは初心者ゆえわかりませんが。
CaptionBoxクラス
とりあえず、クラスモジュールを晒しておこう。
リスト1 クラスモジュール CaptionBox
Option Explicit Private captBox_ As PowerPoint.Shape Private txtFrame_ As PowerPoint.TextFrame Public Property Get Self() As PowerPoint.Shape Set Self = captBox_ End Property Public Property Get TextFrame() As PowerPoint.TextFrame Set TextFrame = txtFrame_ End Property Public Sub init(ByVal targetSlide As Slide, _ ByVal targetText As String) Dim Sld As Slide Set Sld = targetSlide Const DEFAULT_TOP As Single = 10 Const DEFAULT_LEFT As Single = 10 Const DEFAULT_HEIGHT As Single = 45 Const DEFAULT_BOXCOLOR As Long = vbRed Const DEFAULT_FONTSIZE As Single = 28 Const DEFAULT_FONTNAME As String = "游ゴシック" Const DEFAULT_FONTFAREAST As String = "游ゴシック" Const DEFAULT_MARGINTOP As Single = 0.2 Const DEFAULT_MARGINBOTTOM As Single = 0.1 Const DEFAULT_FONTCOLOR As Long = vbWhite 'スライドマスターのサイズに合わせてテキストボックス幅を決める' Dim captWidth As Single captWidth = Sld.Master.Width - (DEFAULT_LEFT * 2) 'テキストボックスを追加' Set captBox_ = targetSlide.Shapes.AddTextbox( _ msoTextOrientationHorizontal, _ DEFAULT_LEFT, DEFAULT_TOP, _ captWidth, DEFAULT_HEIGHT) 'ボックスを塗りつぶす' captBox_.Fill.ForeColor.RGB = DEFAULT_BOXCOLOR 'Module Level変数txtFrame_にTextFrameオブジェクトをセット' Set txtFrame_ = captBox_.TextFrame 'テキストまわりをセット' With txtFrame_ 'ボックス内の上下マージン調整' .MarginTop = convertCentimetersToPoints(DEFAULT_MARGINTOP) .MarginBottom = convertCentimetersToPoints(DEFAULT_MARGINBOTTOM) With .TextRange 'テキストをセット' .Text = targetText 'フォントまわりの調整' With .Font .Name = DEFAULT_FONTNAME .NameFarEast = DEFAULT_FONTFAREAST .Size = DEFAULT_FONTSIZE .Color = DEFAULT_FONTCOLOR End With End With End With End Sub '///センチメートルをポイントに換算する' Private Function convertCentimetersToPoints( _ ByVal valueByCm As Single) As Single Const CONV_RATIO As Single = 28.34646 '1センチは28.34646ポイント' Dim ret As Single ret = valueByCm * CONV_RATIO convertCentimetersToPoints = ret End Function '///Selectメソッド' Public Sub selectMyself() Call captBox_.Select End Sub '///動かす' Public Sub moveTo( _ Optional ByVal moveUp As Single, _ Optional ByVal moveDown As Single, _ Optional ByVal moveToLeft As Single, _ Optional ByVal moveToRight As Single) With captBox_ .Top = .Top - moveUp .Top = .Top + moveDown .Left = .Left - moveToLeft .Left = .Left + moveToRight End With End Sub '///上下位置を反転させる' Public Sub flipHorizontally() Dim topPos As Single topPos = captBox_.Parent.Master.Height - (captBox_.Top + captBox_.Height) captBox_.Top = topPos End Sub
相変わらずのタテ長ですまぬ。
とりあえず、インスタンス生成後、キャプションを置きたいSlide
オブジェクトと、キャプションの文字列を渡してinit
メソッドを実行すると、指定したスライドにキャプション用のテキストボックスが設置される。
デフォルトでは、
- 両サイドに10ポイントのマージン
- テキストボックスの幅は両サイドから10ポイントづつオフセットしたサイズ
- 上マージンは10ポイント
- タテの寸法は45ポイント
- フォントは游ゴシック
- フォントサイズは28ポイント
- テキストの上マージンは0.2センチ
- 同下マージンは0.1センチ
- ボックスは赤で塗りつぶし
- フォント色は白
とまあ、こんな感じ。テキストの上マージンを大きくしているのは、游ゴシックのフォント高が上下アンバランスなため。メイリオだったらもっとアンバランスなので、もっと極端にする必要があると思う。実験はしていない。
プロパティは、Self
とTextFrame
の二つだけ。
Self
は自身(つまり、Shape
オブジェクト)を表す。ホントはデフォルトプロパティにしたいんだけれど、オブジェクト型のデフォルトプロパティは設定できないみたいなので、こんなぶさいくな形にせざるを得なかった。
もう一つのTextFrame
は文字通りTextFrame
オブジェクト。テキストボックスをあれこれいじくるときに、一番よく使うのがShape.TextFrame
オブジェクトなので、こいつだけ直接アクセスできるようにした。うまいやり方なのかどうかはわからん。
次にメソッド。
今のところ、とりあえずselectMyself
メソッド、moveTo
メソッドとflipHorizontally
メソッドの三つ。
selectMyself
は、Shape.Select
をラップしただけ。このクラスの仕様上、[CaptionBox].Self.Select
とも書けてしまうところがイマイチ。
moveTo
メソッドは、文字通りテキストボックスの位置をポイント単位で動かす。
あと、flipHorizontally
メソッドは、テキストボックスの上下位置を反転させる。
かなり大雑把な設計だけれど、まあこのぐらいあれば実用には困らないかな、という感じ。
使ってみる
こんなふうに、2~4枚目のスライドに画像が貼り付いているとする。
この2~4枚目にキャプションを付けよう、という算段。
リスト2 標準モジュール
Public Sub addCaptionMain() Dim Slds As PowerPoint.Slides Set Slds = ActivePresentation.Slides Const TSURUGA_PAKEN As String = _ "敦賀ヨーロッパ軒(1) " & _ "敦賀ヨーロッパ軒(2) " & _ "敦賀ヨーロッパ軒(3)" Dim ar() As String ar = Split(TSURUGA_PAKEN) Dim i As Long Dim captBox As CaptionBox For i = LBound(ar) To UBound(ar) Set captBox = insertCaption(Slds(i + 2), ar(i), True) With captBox With .Self .Fill.ForeColor.RGB = vbBlack .Fill.Transparency = 0.4 End With .TextFrame.HorizontalAnchor = msoAnchorCenter End With Next End Sub Private Function insertCaption( _ ByVal targetSlide As PowerPoint.Slide, _ ByVal captString As String, _ Optional ByVal isBottom As Boolean = False) As CaptionBox Dim ret As CaptionBox Set ret = New CaptionBox Call ret.init(targetSlide, captString) If isBottom Then Call ret.flipHorizontally Set insertCaption = ret End Function
あくまでも実験なので、「敦賀ヨーロッパ軒(1)」~「敦賀ヨーロッパ軒(3)」までの三つの要素を持つ配列を用意して、3枚の画像にそれぞれキャプションを付けることにする。
何十枚も画像があるときは、別途テキストファイルなどでキャプション文字列群を用意すれば良い。
今回は、3枚の画像の下方に順番にキャプションをセットし、塗りつぶし色は黒、透過性を40%にして、テキストは中央揃えにした。
実行結果
こんな感じ。
おわりに
この程度のことができただけでも、結構うれしい。
目障りなエラーチェックマークを除去する
目障りなエラーチェックマークを除去する
状況
セルに数字を文字列で書き込んだ場合、
このように実に目障りなことになる。
セルの左隅の緑色のスピードくじを一掃したい。
スピードくじを一掃するメソッド
おなじみMicrosoft DocsのRange.Errors propertyの項によると、Range
オブジェクトのErrors
プロパティからErrors
オブジェクトを取得して、そのItem
プロパティを操作すれば良いらしい。
Item
プロパティ参照時に指定するインデックスはXlErrorChecks
列挙体を用いる。今回のように「このセルにある数値が、テキスト形式か、またはアポストロフィで始まっています。」が表示される場合は、同じくMicrosoft DocsのXlErrorChecks列挙体の項によると、xlNumberAsText
を用いれば良いっぽい。
上記の点を踏まえ、他のエラーチェックマークにも対応できるようにコーディングした。
リスト1
Public Sub removeErrorMarks( _ ByVal targetRange As Range, _ ByVal errorCheckType As XlErrorChecks) '……(1)' Dim targetCell As Range For Each targetCell In targetRange '……(2)' With targetCell '……(3)' .Errors.Item(errorCheckType).Ignore = True End With Next End Sub
まず、(1)の
Public Sub removeErrorMarks( _ ByVal targetRange As Range, _ ByVal errorCheckType As XlErrorChecks)
で引数を設定。
Range
オブジェクトとチェックするエラーの種類を表すXlErrorChecks
型の値を受け取る。
(2)からの5行
For Each targetCell In targetRange With targetCell .Errors.Item(errorCheckType).Ignore = True End With Next
では、受け取ったRange
オブジェクトのセル一つ一つを巡回して処理。
(3)の
With targetCell '……(3)' .Errors.Item(errorCheckType).Ignore = True End With
で、Errors
オブジェクトのItem
プロパティを参照してError
オブジェクトを取得し(オブジェクト ブラウザーに「Property Item(Index) As Error
」と書いてある。)、そのIgnore
プロパティの値をTrue
にする。
「無視する」をTrue
にすることによって、目障りなスピードくじを除去するのだ。
実行
次のコードで実行。
リスト2
Private Sub testRemoveErrorMarks() Call removeErrorMarks(Selection, xlNumberAsText) End Sub
選択範囲の「このセルにある数値が、テキスト形式か、またはアポストロフィで始まっています。」スピードくじを一掃するコードだ。
ご覧のとおり。
おわりに
え? 「ファイル」メニューから「オプション→数式」に進んで、
このチェックをオフにすればいいじゃん、ってか?
うるせえ、黙ってろ!
わしも今気づいたのじゃw
Enumの謎挙動
Enumの謎挙動
前々から気になっていたこと。
小ネタです。
誤入力防止のための記法
変数名などの誤入力に気づきやすくするために、パスカル記法やキャメル記法を使っている人はかなり多いと思う。
VBAの場合、変数名を、たとえばtooYoungToDie
と宣言しておけば、入力時にtooyoungtodie
と全て小文字で入力しても、(そんな人はいないと思うが、)TOOYOUNGTODIE
と全て大文字で入力しても、改行時や別の行への移動時にVBEが勝手に宣言時の形(この場合だとtooYoungToDie
)になおしてくれる。
綴りに間違いがあったら、この自動変換が作用しないので、誤入力に気づきやすい、という寸法だ。
しかし、この法則がEnumの場合だと成り立たない。
Enumの謎挙動
たとえば、
Private Enum Hoge hgAho hgBoke hgKasu End Enum
このようなEnumを宣言していたとする。
で、このモジュール内のプロシージャで、たとえばhgaho
と要素名を全て小文字で入力したとしよう。
どうなるか。
ご覧あれ。
こうなるのである。
おわりに
この謎挙動によって、致命的に困るということはあまりないと思いますが、知らない間にEnum要素名の見た目が変わってしまっていることがあるので、自作のEnumを使うときは注意しましょう。
以上、小ネタでした。
追伸
あと、これは有名なことかも知れませんが、一応。
自作Enumを使っていると、時々、それこそ何もしていないのに突然
定数式が必要です
エラーを吐き始めることがあります。
それまで問題なく動いていたコードだし、ハイライトされているEnum要素にしても、宣言済みのものなので、軽くパニックになります。
もし、そういう状況に遭遇したら、Enum宣言のPublic
をPrivate
に(またはその逆に)書き換えて、元に戻す、という手法を試みてください。それだけでなおります。
Enumの名前の重なり
Enumの名前の重なり
VBAでEnumを使い始めの頃、その当時はPublic
とPrivate
の使い分けがいい加減だったこともあり、ずいぶん名前の重なりに苦労した。
そこで、最近は列挙体名、要素名それぞれにシンプルなルールに基づいて接頭辞を付け、極力重複が発生しないようにしている。
しかし、ふと思った。「Privateの場合はどうなんだ……?」。
やってみた。
まったく同じEnumを二つのモジュールに搭載する
読んで字の如し。まったく同じEnumを二つのモジュールに搭載し、それぞれそのEnumを利用するメソッドも搭載してみた。
リスト1 標準モジュール M02Sub1
Option Explicit Private Enum Hoge aho boke kasu End Enum Public Sub showMessage() Dim msg As String msg = getMessage(aho) Call MsgBox(msg) End Sub Private Function getMessage( _ ByVal msgCode As Hoge) As String Dim ret As String Select Case msgCode Case aho: ret = "アホ1号" Case boke: ret = "ボケ1号" Case kasu: ret = "カス1号" End Select getMessage = ret End Function
リスト2 標準モジュール M03Sub2
Option Explicit Private Enum Hoge aho boke kasu End Enum Public Sub showMessage() Dim msg As String msg = getMessage(aho) Call MsgBox(msg) End Sub Private Function getMessage( _ ByVal msgCode As Hoge) As String Dim ret As String Select Case msgCode Case aho: ret = "アホ2号" Case boke: ret = "ボケ2号" Case kasu: ret = "カス2号" End Select getMessage = ret End Function
見ての通り、ほぼ全く同じモジュールの内容。
異なるのはそれぞれのgetMessage
の返り値の設定部分のみ。
使ってみる
それぞれのモジュールを利用するコードを次のように書く。
リスト3 標準モジュール M01Main
Option Explicit Private Sub test() Call M02Sub1.showMessage Call M03Sub2.showMessage End Sub
ご覧のように、それぞれのモジュール(標準モジュールM02Sub1
とM03Sub2
)のshowMessage
メソッドを呼び出しているだけ。
同じ名前のメソッドでも、モジュール名から指定すればコンパイルエラーにならずに呼び出すことができる。
参考
実行結果
当然こうなる。何の問題もない。
おわりに
以上述べたとおり、Private
のEnumにおいては、名前の重なりとか全然気にしなくてもよい……と言いたいところなのだが、
この挙動を見ていると、やはり列挙体名の方はともかく、要素名は接頭辞を付けるなどして独自のものにした方が良さそうだ。
それにしても、なぜ「name」だとコンパイルエラーになって「value」とか「address」ならオッケーなのだろう……?
モジュール切り分けの一つの考え方
モジュール切り分けの一つの考え方
長くVBAをやっていると、「このメソッドは、他でも使い回せそうだなー。」という場面に結構出くわす。
今回は、モジュールを切り分けるときの一つの考えかたをば。
文字列操作メソッドに特化したモジュール
文字列を操作するメソッドを括りだして、一つのモジュールにまとめる、というのを例にする。
ただし、複数のメソッドを挙げても煩雑になるだけなので、メソッドは一つだけ、にする。
リスト1 大文字アルファベットを任意の数だけずらすメソッド
'///アルファベットを任意の数分だけずらす' Public Function getOffsetLargeAlphabet( _ ByVal targetAlphabet As String, _ ByVal offsetSize As Long) As String '……(1)' Dim ret As String * 1 '……(2)' '文字コードを取得' Dim charCode As Long '……(3)' charCode = Asc(targetAlphabet) '文字コードを元に文字にする' ret = Chr(charCode + offsetSize) '……(4)' '結果を返す' getOffsetLargeAlphabet = ret '……(5)' End Function
あまりにもしょうもないメソッドゆえ、説明は不要と思うが、一応。
まず(1)の
Public Function getOffsetLargeAlphabet( _ ByVal targetAlphabet As String, _ ByVal offsetSize As Long) As String
で引数と返り値を設定。
第1引数targetAlphabet
は、変換前のアルファベットを受け取る。
第2引数offsetSize
は、ずらすサイズ。
たとえば、targetAlphabet
が「B
」で、offsetSize
が「3
」だったら、「E
」、offsetSize
が「-1
」だったら、「A
」を返す、ということ。
(2)の
Dim ret As String * 1
で返り値用の変数を準備。返すのは1文字と決まっているので、固定長にしている。
(3)からの2行
Dim charCode As Long charCode = Asc(targetAlphabet)
では、変数charCode
を準備し、Asc
関数を用いて変換前のアルファベットの文字コードを取得。
(4)の
ret = Chr(charCode + offsetSize)
で、今度はChr
関数を用いて、必要なだけずらしたアルファベットを取得。
最後に(5)の
getOffsetLargeAlphabet = ret
で値を返しておしまい。
……とまあ、こんなしょうもないメソッド。
予想される不具合
しかし、たいていの人はすぐに気づくと思うが、リスト1のgetOffsetLargeAlphabet
メソッドはかなり問題が多い。
まず、第1引数のtargetAlphabet
に大文字アルファベットが渡される保障はどこにもないし、2文字以上の文字列が渡されることだってあり得る。
また、第2引数のoffsetSize
にしても、不適切な数値が与えられることに対して、何の対策もない。
だれでも思いつくような問題点に、何の対策もないのだ。
予想される不具合に対応する
こうした場合、対応は大きく分けて次の二つになろう。すなわち、
- 不適切な引数が与えられたときは、特異な値を返すようにする
- 不適切な引数が与えられたときは、エラーを起こす
この二つである。
一つ目は、そもそもエラーを起こさないというアプローチ。で、二つ目は積極的にエラーを起こすというアプローチである。
最近は、二つ目のアプローチを取ることが多い。
積極的にエラーを起こす
不適切な使い方が為された場合には、オリジナルのエラーを起こす、ということにする。そのために最近取り入れているのは、次の二つである。すなわち、
- エラー発生原因を場合分けするために列挙体を用いる
- メソッドにエラーソースを示す文字列を仕込んでおく
この二つである。順に説明する。
リスト2 オリジナルのエラーを発生させる
'///宣言セクション' 'エラー番号の土台になる数字' Private Const ERR_NUM_BASE As Long = 20000 '……(1)' 'エラー発生源識別用列挙体' Private Enum ErrorCode '……(2)' suecNotSingleCharacter = 1 suecNotAllowedSize suecNotLargeAlphabet End Enum 'Methods' Private Sub raiseError(ByVal errCode As ErrorCode, _ ByVal errSource As String) '……(3)' Dim errMsg As String 'エラーメッセージを取得。適宜追加。' Select Case errCode Case suecNotSingleCharacter errMsg = "Arg ""targetAlphabet"" must be a single character." Case suecNotAllowedSize errMsg = "Arg ""offsetSize"" is not allowed size." Case suecNotLargeAlphabet errMsg = "Arg ""targetAlphabet"" is not large alphabet." Case Else errMsg = "Some error has occurred." End Select Call Err.Raise(Number:=ERR_NUM_BASE + errCode, _ Source:=errSource, _ Description:=errMsg) End Sub
(1)の
Private Const ERR_NUM_BASE As Long = 20000
は、エラー番号の土台となる数字。
組み込みのエラー番号と重ならないように、自作エラー番号は10000
番台を使うようにしている。今回は20000
番台を使うことにした。用途別に切り分けたモジュールごとに付番しておけば良いと思う。
(2)の
Private Enum ErrorCode suecNotSingleCharacter = 1 suecNotAllowedSize suecNotLargeAlphabet End Enum
は、エラー発生原因識別用の列挙体。
このモジュール内でしか使わないので、Private
指定。各要素の先頭にsuec
とあるのは、名前が重ならないようにするための接頭語。このモジュールはStringUtil
と名づけていて(su
)、そのモジュールのErrorCode
という列挙体なので(ec
)、というだけ。
(3)からがエラー発生用メソッド。
(3)の
Private Sub raiseError(ByVal errCode As ErrorCode, _ ByVal errSource As String)
で引数を指定。
第1引数のerrCode
はエラー発生原因識別用の値。
第2引数のerrSource
については後述する。
このraiseError
メソッドの残りの部分については説明を省くが、単に第1引数によって場合分けをして、Err
オブジェクトのRaise
メソッドでエラーを起こしているだけだ。
ただし、Raise
メソッドを用いる際に、引数Source
まで指定しているところがポイント。
getOffsetLargeAlphabetメソッドの改良
以上のことを踏まえて、リスト1のgetOffsetLargeAlphabet
を改良する。
まずは、改良後のコードをどうぞ。
リスト3 getOffsetLargeAlphabetメソッド
Public Function getOffsetLargeAlphabet( _ ByVal targetAlphabet As String, _ ByVal offsetSize As Long) As String Dim ret As String * 1 'エラーソース文字列……(1)' Const ERR_SRC As String = _ "StringUtil Module : getOffsetLargeAlphabet Method" 'ガード節' '1文字でなかったらエラー……(2)' If Len(targetAlphabet) <> 1 Then _ Call raiseError(suecNotSingleCharacter, ERR_SRC) '大文字のアルファベットでなかったらエラー……(3)' If Not targetAlphabet Like "[A-Z]" Then _ Call raiseError(suecNotLargeAlphabet, ERR_SRC) '文字コードを取得' Dim charCode As Long charCode = Asc(targetAlphabet) ret = Chr(charCode + offsetSize) 'ずらした結果、大文字アルファベットでなくなる場合はエラー……(4)' If Not ret Like "[A-Z]" Then _ Call raiseError(suecNotAllowedSize, ERR_SRC) '結果を返す' getOffsetLargeAlphabet = ret End Function
リスト1から変わったところに番号を付した。
まず(1)の
Const ERR_SRC As String = _ "StringUtil Module : getOffsetLargeAlphabet Method"
リスト(2)のエラー発生用メソッドraiseError
に渡す第2引数用の文字列。
このメソッド固有の文字列なので、プロシージャレベルの定数にした。
プロシージャレベルの定数は、こういうふうに使えば良いのだ。
次に、(2)の
If Len(targetAlphabet) <> 1 Then _ Call raiseError(suecNotSingleCharacter, ERR_SRC)
では、引数targetAlphabet
の文字数を調べ、1文字でなかったら、raiseError
メソッドにsuecNotSingleCharacter
とERR_SRC
を渡す。
同様に(3)の
If Not targetAlphabet Like "[A-Z]" Then _ Call raiseError(suecNotLargeAlphabet, ERR_SRC)
では、引数targetAlphabet
がアルファベット大文字かどうかを調べて、違っていたらraiseError
メソッドにsuecNotLargeAlphabet
とERR_SRC
を渡す。
(4)の
If Not ret Like "[A-Z]" Then _ Call raiseError(suecNotAllowedSize, ERR_SRC)
では、変換後の文字について、大文字アルファベットでなくなっていたら、raiseError
メソッドにsuecNotAllowedSize
とERR_SRC
を渡す。
このような形で、不適切な引数が渡されたらエラーを吐くようにした。
使ってみる
上記メソッドを搭載したモジュールにStringUtil
と名前を付けて、実験してみる。
こんな感じ。
また、Err.Raise
メソッドを用いる際に、引数Source
を指定していることについては、次のようなコードで実験。
リスト4
Private Sub test() On Error Resume Next Call Err.Clear Debug.Print StringUtil.getOffsetLargeAlphabet("AHO", 2) Debug.Print Err.Source Call Err.Clear Debug.Print StringUtil.getOffsetLargeAlphabet("A", 28) Debug.Print Err.Source Call Err.Clear Debug.Print StringUtil.getOffsetLargeAlphabet("a", 2) Debug.Print Err.Source On Error GoTo 0 End Sub
このように、getOffsetLargeAlphabet
メソッドにわざとエラーを起こすような引数を渡し、そのたびにErr
オブジェクトのSource
プロパティの値をイミディエイトに吐き出させる。
実行すると、
こうなる。
どのモジュールのどのメソッドでエラーが発生したのか、追跡できるようになる。
おわりに
異様に長くなってしまった。
メソッドを切り分けるときの一つのパターンとして、ご紹介しました。