FileSystemObjectによるファイル取り出しの順序

FileSystemObjectによるファイル取り出しの順序

おなじみ、OFFICE TANAKAのコチラのページによると、「Dir関数が返すファイルの順番」は、

ディスクのフォーマットによって異なります。最近主流のNTFSでフォーマットされているディスクでは、ファイルが保存された順番(タイムスタンプ)にかかわらず、ファイル名の順番(昇順)で返ります。

ということらしい。また、

FATと呼ばれる形式でフォーマットでされたディスクでは、ファイル名の順番ではなく、ディスクに保存された順番で返ります。

とも。

では、FileSystemObjectFilesコレクションをFor ~ Eachで回した場合はどうなるのか。

やってみた。

準備

まずは、Sampleというフォルダを作り、その中にテキストファイルを作った。

f:id:akashi_keirin:20190908204830j:plain

で、その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

実行結果

f:id:akashi_keirin:20190908204837j:plain

f:id:akashi_keirin:20190908204841j:plain

ご覧の通り。

おわりに

確かに、ファイルシステムによって取り出し順は異なるようだ。

引数二つのProperty

引数二つのProperty

前回

akashi-keirin.hatenablog.com

作成した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)でテキストのヨコ方向の位置を中央揃えにしておしまい。

実行結果

f:id:akashi_keirin:20190908125907j:plain

この状態でリスト2を実行すると、

f:id:akashi_keirin:20190908125910j:plain

このとおり。

おわりに

問題は、(2)の入力方法がわかりやすいかどうか、だと思う。

入力中に表示されるヒントは

f:id:akashi_keirin:20190908182240g:plain

こんな感じ。

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センチ
  • ボックスは赤で塗りつぶし
  • フォント色は白

とまあ、こんな感じ。テキストの上マージンを大きくしているのは、游ゴシックのフォント高が上下アンバランスなため。メイリオだったらもっとアンバランスなので、もっと極端にする必要があると思う。実験はしていない。

プロパティは、SelfTextFrameの二つだけ。

Selfは自身(つまり、Shapeオブジェクト)を表す。ホントはデフォルトプロパティにしたいんだけれど、オブジェクト型のデフォルトプロパティは設定できないみたいなので、こんなぶさいくな形にせざるを得なかった。

もう一つのTextFrameは文字通りTextFrameオブジェクト。テキストボックスをあれこれいじくるときに、一番よく使うのがShape.TextFrameオブジェクトなので、こいつだけ直接アクセスできるようにした。うまいやり方なのかどうかはわからん。

次にメソッド。

今のところ、とりあえずselectMyselfメソッド、moveToメソッドとflipHorizontallyメソッドの三つ。

selectMyselfは、Shape.Selectをラップしただけ。このクラスの仕様上、[CaptionBox].Self.Selectとも書けてしまうところがイマイチ。

moveToメソッドは、文字通りテキストボックスの位置をポイント単位で動かす。

あと、flipHorizontallyメソッドは、テキストボックスの上下位置を反転させる。

かなり大雑把な設計だけれど、まあこのぐらいあれば実用には困らないかな、という感じ。

使ってみる

f:id:akashi_keirin:20190907225139j:plain

こんなふうに、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%にして、テキストは中央揃えにした。

実行結果

f:id:akashi_keirin:20190907225144j:plain

f:id:akashi_keirin:20190907225147j:plain

f:id:akashi_keirin:20190907225152j:plain

こんな感じ。

おわりに

この程度のことができただけでも、結構うれしい。

目障りなエラーチェックマークを除去する

目障りなエラーチェックマークを除去する

状況

セルに数字を文字列で書き込んだ場合、

f:id:akashi_keirin:20190829170610j:plain

このように実に目障りなことになる。

セルの左隅の緑色のスピードくじを一掃したい。

スピードくじを一掃するメソッド

おなじみ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

選択範囲の「このセルにある数値が、テキスト形式か、またはアポストロフィで始まっています。」スピードくじを一掃するコードだ。

f:id:akashi_keirin:20190829170619g:plain

ご覧のとおり。

おわりに

え? 「ファイル」メニューから「オプション→数式」に進んで、

f:id:akashi_keirin:20190829170614j:plain

このチェックをオフにすればいいじゃん、ってか?

うるせえ、黙ってろ!

わしも今気づいたのじゃw

Enumの謎挙動

Enumの謎挙動

前々から気になっていたこと。

小ネタです。

誤入力防止のための記法

変数名などの誤入力に気づきやすくするために、パスカル記法やキャメル記法を使っている人はかなり多いと思う。

VBAの場合、変数名を、たとえばtooYoungToDieと宣言しておけば、入力時にtooyoungtodieと全て小文字で入力しても、(そんな人はいないと思うが、)TOOYOUNGTODIEと全て大文字で入力しても、改行時や別の行への移動時にVBEが勝手に宣言時の形(この場合だとtooYoungToDie)になおしてくれる。

綴りに間違いがあったら、この自動変換が作用しないので、誤入力に気づきやすい、という寸法だ。

しかし、この法則がEnumの場合だと成り立たない。

Enumの謎挙動

たとえば、

Private Enum Hoge
  hgAho
  hgBoke
  hgKasu
End Enum

このようなEnumを宣言していたとする。

で、このモジュール内のプロシージャで、たとえばhgahoと要素名を全て小文字で入力したとしよう。

どうなるか。

ご覧あれ。

f:id:akashi_keirin:20190828070325g:plain

こうなるのである。

おわりに

この謎挙動によって、致命的に困るということはあまりないと思いますが、知らない間にEnum要素名の見た目が変わってしまっていることがあるので、自作のEnumを使うときは注意しましょう。

以上、小ネタでした。

追伸

あと、これは有名なことかも知れませんが、一応。

自作Enumを使っていると、時々、それこそ何もしていないのに突然

定数式が必要です

エラーを吐き始めることがあります。

それまで問題なく動いていたコードだし、ハイライトされているEnum要素にしても、宣言済みのものなので、軽くパニックになります。

もし、そういう状況に遭遇したら、Enum宣言のPublicPrivateに(またはその逆に)書き換えて、元に戻す、という手法を試みてください。それだけでなおります。

Enumの名前の重なり

Enumの名前の重なり

VBAEnumを使い始めの頃、その当時はPublicPrivateの使い分けがいい加減だったこともあり、ずいぶん名前の重なりに苦労した。

そこで、最近は列挙体名、要素名それぞれにシンプルなルールに基づいて接頭辞を付け、極力重複が発生しないようにしている。

akashi-keirin.hatenablog.com

しかし、ふと思った。「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

ご覧のように、それぞれのモジュール(標準モジュールM02Sub1M03Sub2)のshowMessageメソッドを呼び出しているだけ。

同じ名前のメソッドでも、モジュール名から指定すればコンパイルエラーにならずに呼び出すことができる。

参考

akashi-keirin.hatenablog.com

実行結果

f:id:akashi_keirin:20190827063756g:plain

当然こうなる。何の問題もない。

おわりに

以上述べたとおり、PrivateEnumにおいては、名前の重なりとか全然気にしなくてもよい……と言いたいところなのだが、

f:id:akashi_keirin:20190827063808g:plain

この挙動を見ていると、やはり列挙体名の方はともかく、要素名は接頭辞を付けるなどして独自のものにした方が良さそうだ。

それにしても、なぜ「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メソッドにsuecNotSingleCharacterERR_SRCを渡す。

同様に(3)の

If Not targetAlphabet Like "[A-Z]" Then _
  Call raiseError(suecNotLargeAlphabet, ERR_SRC)

では、引数targetAlphabetがアルファベット大文字かどうかを調べて、違っていたらraiseErrorメソッドにsuecNotLargeAlphabetERR_SRCを渡す。

(4)の

If Not ret Like "[A-Z]" Then _
  Call raiseError(suecNotAllowedSize, ERR_SRC)

では、変換後の文字について、大文字アルファベットでなくなっていたら、raiseErrorメソッドにsuecNotAllowedSizeERR_SRCを渡す。

このような形で、不適切な引数が渡されたらエラーを吐くようにした。

使ってみる

上記メソッドを搭載したモジュールにStringUtilと名前を付けて、実験してみる。

f:id:akashi_keirin:20190826191829g:plain

f:id:akashi_keirin:20190826191843g:plain

こんな感じ。

また、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プロパティの値をイミディエイトに吐き出させる。

実行すると、

f:id:akashi_keirin:20190826191814j:plain

こうなる。

どのモジュールのどのメソッドでエラーが発生したのか、追跡できるようになる。

おわりに

異様に長くなってしまった。

メソッドを切り分けるときの一つのパターンとして、ご紹介しました。