VBA 開発中マクロブックのバックアップを取るマクロ

開発中のマクロで、こまめに保存しておきたいケースがあったのでコードを書いてみた。
これは開発中のブックに埋め込んで利用する前提。私は標準モジュール「DevTools」に保存して使っている。

Sub BackupFile()
    'Microsoft Scripting Runtimeへの参照設定が必要
    Dim fso As FileSystemObject: Set fso = New FileSystemObject
    With ThisWorkbook
        Dim f As File: Set f = fso.GetFile(.FullName)
        Dim backupFolderPath As String: backupFolderPath _
            = .Path & "\backup_" & Left(f.Name, Len(f.Name) - Len(fso.GetExtensionName(f.Path)) - 1)
        If Not fso.FolderExists(backupFolderPath) Then fso.CreateFolder backupFolderPath
        .SaveCopyAs backupFolderPath & "\" & Format(Now, "yyyymmddhhMMss") & "_" & .Name
    End With
End Sub

実行すると、そのブックと同じパスにbackup_[ブック名(拡張子除く)]というフォルダーが作成され、編集中のブックのコピーが保存される。

ファイル名は秒単位なので1秒に複数回実行すると古いコピーが上書きされてしまうことに注意。
（そんな頻度で実行するシチュエーションは無いと思うが）

いつもなら少し大掛かりなマクロではGitHubを使ってバージョン管理するんだけど、今回はブック本体に公開できない情報を含むので、ファイルのコピーを残すという原始的なバックアップに頼ることにした。

このくらいのコードならTwitterに投稿しようとしたら文字数限界だったので記事にした次第。

Excel VBAでスクロール可能なフォームのアイデア

Excel VBAでフォームを作る際に、項目が多くてウインドウの高さに収まりきらないことがある。
そこで今回はスクロールによってフォーム全体をウインドウに収めるアイデアを紹介する。

言葉では何がやりたいのか伝わりにくいと思うのでまずは動作イメージから。

動作イメージ

注意事項

あくまでアイデアなので、実用化にはまだ色々と工夫が必要になる。
今のままではデータの取り出しすらままならないのだが、本記事のコードを読める人なら自分で実装できると思われる。

コード

クラスモジュール「FieldLocator」

まずはクラスモジュールを挿入し、オブジェクト名をFieldLocatorとする。
このFieldLocatorはデータフィールド用のテキストボックスとそのラベルを生成し、座標を管理するオブジェクトだ。
最初のFieldLocatorから次のFieldLocatorへ、そこからまた次のFieldLocatorへと参照が張られ、とリスト構造(数珠状)でつながる仕組み。
1カラムのテキストボックス、2カラムのテキストボックスのみ対応している。

コードはこちら。

'DEBUG_MODEはラベルを配置するときに色が付いてないとサイズが分かりづらいので作った。
'Falseにすると色付け無しになる。
#Const DEBUG_MODE = False
Private top_ As Long
Public Left As Long
Public FieldName1 As String
Public FieldName2 As String
Public LabelWidth As Integer
Public LineCount As Integer
Public L1 As MSForms.Label, L2 As MSForms.Label
Public T1 As MSForms.TextBox, T2 As MSForms.TextBox

'すべてのFieldLocatorは最初のアイテムからNextItemを辿って数珠状につながる想定。
'これにより、最初のアイテムのTopプロパティーを変更すると、連鎖的に他のアイテムのTopプロパティーも変わる。
'つまり全てのコントロールが最初のアイテムに連動して動くので、スクロールバーで動かすのは最初のアイテムだけでOKになる。
Public NextItem As FieldLocator

Const FONT_SIZE = 12, FONT_HEIGHT = 15, FONT_MARGIN = 6

Private Sub Class_Initialize()
    Me.LineCount = 1
    Me.LabelWidth = 100
End Sub
Public Property Get Self() As FieldLocator
    Set Self = Me
End Property

Public Function CreateNext() As FieldLocator
    With New FieldLocator
        .Top = Me.Bottom + 10
        .Left = Me.Left
        .LabelWidth = Me.LabelWidth
        Set NextItem = .Self
        Set CreateNext = NextItem
    End With
End Function

Public Property Let Top(t_ As Long)
    top_ = t_
    If Not T1 Is Nothing Then
        CCnt(T1).Top = t_
        CCnt(L1).Top = CCnt(T1).Top + 2
        If Not T2 Is Nothing Then
            CCnt(T2).Top = CCnt(T1).Top
            CCnt(L2).Top = CCnt(L1).Top
        End If
    End If
    If Not NextItem Is Nothing Then
        NextItem.Top = Me.Bottom + 10
    End If
End Property
Public Property Get Top() As Long
    If T1 Is Nothing Then
        Top = top_
    Else
        Top = CCnt(T1).Top
    End If
End Property
Public Property Get Bottom() As Long
    Bottom = CCnt(T1).Top + CCnt(T1).Height
End Property

Sub AddInputBox(f As UserForm)
    Set L1 = f.Controls.Add("Forms.Label.1")
    L1.Font.Name = "Meiryo UI"
    L1.Font.Size = FONT_SIZE
    CCnt(L1).Height = FONT_HEIGHT + FONT_MARGIN
    CCnt(L1).Width = LabelWidth
    CCnt(L1).Left = Left
    L1.TextAlign = fmTextAlignRight
    L1.Caption = FieldName1
#If DEBUG_MODE Then
    L1.BackColor = rgbLightYellow
#End If
    
    Set T1 = f.Controls.Add("Forms.Textbox.1")
    T1.BorderStyle = fmBorderStyleSingle
    T1.Font.Name = "Meiryo UI"
    T1.Font.Size = FONT_SIZE
    T1.MultiLine = LineCount > 1
    T1.ScrollBars = fmScrollBarsVertical
    T1.EnterKeyBehavior = LineCount > 1
    CCnt(T1).Height = FONT_HEIGHT * LineCount + FONT_MARGIN
    CCnt(T1).Width = 450
    CCnt(T1).Left = CCnt(L1).Left + CCnt(L1).Width + 10
    CCnt(T1).Top = top_
    
    CCnt(L1).Top = CCnt(T1).Top + 2
End Sub

Sub AddTwinInputBox(f As UserForm)
    Set L1 = f.Controls.Add("Forms.Label.1")
    L1.Font.Name = "Meiryo UI"
    L1.Font.Size = FONT_SIZE
    CCnt(L1).Height = FONT_HEIGHT + FONT_MARGIN
    CCnt(L1).Width = LabelWidth
    CCnt(L1).Left = Left
    L1.TextAlign = fmTextAlignRight
    L1.Caption = FieldName1
#If DEBUG_MODE Then
    L1.BackColor = rgbLightYellow
#End If

    Set L2 = f.Controls.Add("Forms.Label.1")
    L2.Font.Name = "Meiryo UI"
    L2.Font.Size = FONT_SIZE
    CCnt(L2).Height = FONT_HEIGHT + FONT_MARGIN
    CCnt(L2).Width = LabelWidth
    L2.TextAlign = fmTextAlignRight
    L2.Caption = FieldName2
#If DEBUG_MODE Then
    L2.BackColor = rgbLightYellow
#End If
    
    Set T1 = f.Controls.Add("Forms.Textbox.1")
    T1.BorderStyle = fmBorderStyleSingle
    T1.Font.Name = "Meiryo UI"
    T1.Font.Size = FONT_SIZE
    T1.MultiLine = LineCount > 1
    T1.ScrollBars = fmScrollBarsVertical
    T1.EnterKeyBehavior = LineCount > 1
    CCnt(T1).Height = FONT_HEIGHT * LineCount + FONT_MARGIN
    CCnt(T1).Width = (450 - 20 - LabelWidth) / 2
    CCnt(T1).Left = CCnt(L1).Left + CCnt(L1).Width + 10
    CCnt(T1).Top = top_
    
    CCnt(L1).Top = CCnt(T1).Top + 2
    CCnt(L2).Left = CCnt(T1).Left + CCnt(T1).Width + 10
    CCnt(L2).Top = CCnt(L1).Top
    
    Set T2 = f.Controls.Add("Forms.Textbox.1")
    T2.BorderStyle = fmBorderStyleSingle
    T2.Font.Name = "Meiryo UI"
    T2.Font.Size = FONT_SIZE
    T2.MultiLine = LineCount > 1
    T2.ScrollBars = fmScrollBarsVertical
    T2.EnterKeyBehavior = LineCount > 1
    CCnt(T2).Height = FONT_HEIGHT * LineCount + FONT_MARGIN
    CCnt(T2).Width = CCnt(T1).Width
    CCnt(T2).Left = CCnt(L2).Left + CCnt(L2).Width + 10
    CCnt(T2).Top = top_
End Sub

Private Function CCnt(o As Object) As MSForms.Control
    Set CCnt = o
End Function

フォームモジュール

ユーザーフォームを挿入し、次のコードを張り付ける。
フォームのオブジェクト名は任意で良い。

Dim FirstField As FieldLocator
Private WithEvents ScrollBar1 As MSForms.ScrollBar
Private Sub ScrollBar1_Change()
    'ScrollBarはマイナス値をMaxに設定すると、増分がマイナスになるので、
    '次のようにシンプルに書ける。
    FirstField.Top = ScrollBar1.Value
End Sub

Private Sub UserForm_Initialize()
    Set ScrollBar1 = Me.Controls.Add("Forms.ScrollBar.1")
    Const GOLDEN_RATIO = 1.618
    Me.Width = 800 '所有してるモニタの最低解像度の横幅が800(SVGA)なので。ちなみに最高は1920。
    Me.Height = Me.Width / GOLDEN_RATIO '黄金比を用いて収まりよく。
    ScrollBar1.Width = 20
    ScrollBar1.Left = Me.Width - 25
    ScrollBar1.Height = Me.Height - 22
    ScrollBar1.SmallChange = 5
    ScrollBar1.LargeChange = 20
    With New FieldLocator
        '最初の作成で設定する
        Set FirstField = .Self
        .Top = 30
        ScrollBar1.Min = .Top
        .Left = 100
        .LabelWidth = 80
        
        '以降の設定項目は共通
        .FieldName1 = "件名"
        .LineCount = 1 'LineCountは省略すると1になる。
        .AddInputBox Me 'これは1カラムの入力フィールドを追加するコマンド
        
    '以降はCreateNextのメソッドチェーンでFieldLocatorを数珠状に作っていく。
    With .CreateNext
        .FieldName1 = "概要"
        .LineCount = 2
        .AddInputBox Me
    With .CreateNext
        .FieldName1 = "詳細"
        .LineCount = 10
        .AddInputBox Me
    With .CreateNext
        '2カラムの入力フィールドの場合はこうする。
        .FieldName1 = "開始日"
        .FieldName2 = "有効期限"
        .AddTwinInputBox Me
    With .CreateNext
        .FieldName1 = "担当者"
        .AddInputBox Me
    With .CreateNext
        .FieldName1 = "連絡先"
        .AddInputBox Me
    With .CreateNext
        .FieldName1 = "備考欄"
        .LineCount = 10
        .AddInputBox Me
    With .CreateNext
        .FieldName1 = "その他"
        .AddInputBox Me
        
        '最後の要素のBottomを利用してScrollBarのMax値
        '(プロパティ名はMaxだが、実際にはマイナス値なので最小)を決定する。
        ScrollBar1.Max = Me.Height - .Bottom - 30
    
    'メソッドチェーンが終わると、残念ながら大量のEnd With文
    End With: End With: End With: End With: End With: End With: End With: End With
End Sub

フォーム自体を除き、パーツはすべてコードで生成する為、フォーム上には何も配置しなくて良い。
サイズもコードで指定するのでそのままで良い。
フォームを起動すると冒頭の動作イメージのとおり操作できる。

あとがき

Access Formを使えばこんなことは朝飯前なんだけど、Excelにちょっとしたフォームが欲しくなることもある。
標準のフォーム機能ってのもあった気がするけど、使い勝手がとても悪いので、自作を試みているところ。

ちょっとしたフォームにしては作り方が大掛かりに見えるかもしれないが、使いまわしができ、デザインの微調整が必要なく、単に項目を指定していくだけで完成する汎用的なフォーム作成が目的なので、この手間は仕方がない。

おまけ

以下はスクロールバーをMin 0% Max 100%のパーセンテージで管理しようともがいてる図。

結局、Maxをマイナス値にするとマイナスに向かって進むことが判明し、コードをよりシンプルに出来るのでパーセンテージ管理は没になった。

以下はHeight Managerというオブジェクトでラベルとテキストボックスを管理し、双方向ポインタで結ぶことで先頭を動かすと全体が動く仕組みを作ろうとした図。

このアイデアは別の形(FieldLocator)で実現した。実際には片方向ポインタで十分だった。
上下のボーダーを跨ぐとコントロールを非表示にするアイデアだったが実装に至っていない。

現在はスクロールによってフォームの上端・下端でコントロールが見えなくなるが、本当はZOrderをトップにしたラベルの下に潜り込ませて、完全に潜ったらHiddenにしようと考えている。ちょっと管理すべき項目が多くて混乱中。

VBA 連続して与えられた数の最大値、最小値を求めるクラス

今回は連続して値を投げ込み、その最大値・最小値を求めるクラスを紹介する。
かなりシンプルなのでわざわざ記録しておくこともないかなと迷ったけど、クラス初心者向けにはちょうど良いサンプルになりそうなのでとりあえず。

クラスモジュールのコード

クラス名はNumericAggregationObjectとし、次のコードを張り付ける。

Public Data As Collection
Public Max As Variant
Public Min As Variant
Public Sum As Variant
Public Property Get Avg() As Variant
    Avg = Sum / Data.Count
End Property

Sub Add(x As Variant)
    If Data.Count = 0 Then
        Max = x
        Min = x
    End If
    If Max < x Then Max = x
    If Min > x Then Min = x
    Sum = Sum + x
    Data.Add x
End Sub

Private Sub Class_Initialize()
    Set Data = New Collection
    Max = 0
    Min = 0
    Sum = 0
End Sub

まぁ見ての通り、オブジェクト外からデータ書き換えし放題のゆるゆるクラス。
個人で使うには十分だけど、クリティカルな業務で使おうと思ったらPropertyでアクセサ作って不正データブロックするなり、もう少しセキュアにした方が良い。

使い方

こちらのサンプル参照。

Sub Sample()
    Dim nao As NumericAggregationObject
    Set nao = New NumericAggregationObject
    nao.Add 10
    nao.Add 12
    nao.Add 9
    Debug.Print "Max:" & nao.Max
    Debug.Print "Min:" & nao.Min
    Debug.Print "Sum:" & nao.Sum
    Debug.Print "Avg:" & nao.Avg
End Sub

動機

これを作った動機はExcel VBAのユーザーフォーム設計で、テキストボックスの最適幅を求める課題が生じたこと。

Meiryo UIはプロポーショナルフォントなので、テキストの内容によって幅が伸縮する。
以前は以下のテキストを使用して幅を作っていたんだけど、実際に自然な文章を入れてみると幅が結構ズレるので、今回は実際の文章を使って最大幅を見つけることにした。
"■■■■■□□□□□■■■■■□□□□□■■■■■□□□□□■■■■■□□□□□"

どうやってやったかは、以下のとおり。

1) ブログから適当な文章を持ってきてSheet1のA1セルに張り付ける。

2) 改行を除去


3) 以下の記事から幅取得用のモジュールを準備
thom.hateblo.jp
※使うのはMeasureTextWidth関数
4) 80バイト切り出したときの最大幅を取得

Sub 最大幅取得()
    Dim t As String
    t = String(80, "*")
    Dim n As Long: n = 1
    Dim nao As NumericAggregationObject
    Set nao = New NumericAggregationObject
    Do While LenB(t) >= 80
        t = MidB(Sheet1.Range("A1"), n, 80)
        w = MeasureTextWidth(t, "Meiryo UI")
        nao.Add w
        n = n + 2
    Loop
    Debug.Print nao.Max
End Sub

実行結果は283と出た。

5) 最大幅に合致する文を取得

Sub 最大幅に合致する文を取得()
    Const 最大幅 = 283
    Dim t As String
    t = String(80, "*")
    n = 1
    Do While LenB(t) >= 80
        t = MidB(Sheet1.Range("A1"), n, 80)
        w = MeasureTextWidth(t, "Meiryo UI")
        If w = 最大幅 Then Debug.Print t
        n = n + 2
    Loop
End Sub

実行結果は「の呼び出し履歴は、一番上が中断したプロシージャ、二番目がその呼び出し元、三番目が」となった。

6) この文をテキストボックスのTextプロパティに入れて、ぎりぎり入る幅にする。
テキストボックスのWidthプロパティを見て、キリの良い数字に切り上げる。(450にした)

以上

これでまぁ大半のテキストはうまく収まると思われる。

ちなみにこれで、私が作るユーザーフォームは基準値が出そろった。

Font.Name	Meiryo UI
Font.Size	12
BorderStyle	fmBorderStyleSingle
Height	15 × 行数 + 6
Width(最大)	450(1カラムレイアウト時)

Heightの計算式の根拠については以下の記事を参照
thom.hateblo.jp

Font.Sizeの根拠については以下の記事を参照
thom.hateblo.jp

VBA 呼び出し履歴を使ったデバッグ

VBEditorには呼び出し履歴という機能がある。

たとえば、プロシージャProcAからプロシージャProcBを呼び出した際にProcBで実行時エラーを吐いて中断したとする。
このとき、中断モードでプロシージャ呼び出しを遡ることができる機能である。

本記事ではこれを使ったデバッグテクニックを紹介する。

まず次のコードを実行してみる。

Sub ProcA()
    For i = -5 To 5
        Call ProcB(i)
    Next
End Sub

Sub ProcB(x)
    Debug.Print 100 / x
End Sub

するとゼロ除算エラーが発生する。ここでデバッグをクリックすると、

エラーが発生した行で中断モードになる。

ここでxが0だからエラーになったのは自明である。
カーソルを乗せるか、イミディエイトウインドウで「?x」と入力すればxが0であることが分かる。

しかしなぜxが0になったのかが分からないことも多い。
今回はサンプルなのでiが0だからに決まってるじゃないかと思われるかもしれないが、実務コードは複雑なのですぐに気づかないこともある。

しかし、この状態でイミディエイトウインドウで「?i」と入力しても、空文字が返るだけ。
呼び出し元のiを知るには、iにカーソルを当てるという方法もあるが、もう少し複雑な検証をしたい場合もある。

ここで呼び出し元スコープに戻るためには、Ctrl+Lで呼び出し履歴ウィンドウを開く。(表示メニューからでもOK)

この呼び出し履歴は、一番上が中断したプロシージャ、二番目がその呼び出し元、三番目がさらにそれの呼び出し元というふうに下に行くほど呼び出しを遡ることができる。

呼び出し元を表示させると、グリーンのカーソルで呼び出し元コードが示される。このときローカルウインドウを表示させると呼び出し元スコープ(ProcA)の変数が表示されているのが分かる。

つまり呼び出し履歴を使用することで、実行エラー発生する条件を呼び出し元に遡って分析することができる。

ここでProcAのiは参照渡しでProcBのxに格納されているので、ローカルウインドウやイミディエイトウインドウで直接値を書き換えると、xの値も変わる。試しにiを1に書き換えてからF5キーで続行すると正しくマクロ実行を継続することができる。
※もし値渡しだった場合は呼び出し元のProcAでiを書き換えてもxは書き換わらないので注意。

以上

VBA Debug.Print、Debug.Assertの代用クラス案

Debug.Print、Debug.Assertはいずれもデバッグ用の機能なので、リリース版のコードには不要である。
かといって消してしまうと、次にコードを修正するときに面倒なので残しておきたい。

そこで代用クラスを作ってみたので紹介。

まずクラスモジュールを挿入し、オブジェクト名をTesterにする。
コードは次のとおり。

#Const VALID = True
Const STOP_ON_ASSERTION_FAILURE = False

Sub Out(v As Variant)
    #If VALID Then
        Debug.Print v
    #End If
End Sub

Sub Assert(exp As Boolean, Optional message As String = "Undefined")
    #If VALID Then
        If Not exp Then
            Out "Assert Failure:" & message
            If STOP_ON_ASSERTION_FAILURE Then
                Stop
            End If
        End If
    #End If
End Sub

Sub Never(exp As Boolean, Optional message As String = "Undefined")
    #If VALID Then
        If exp Then
            Out "Unexpected Occured:" & message
            If STOP_ON_ASSERTION_FAILURE Then
                Stop
            End If
        End If
    #End If
End Sub

これをエスポートする。

そしてテキストエディタでAttribute VB_PredeclaredId = FalseとなっているところをTrueに変更する。

元あったTesterクラスは開放し、編集後のTester.clsをインポートする。

これで、変数宣言やインスタンスセットを省略できる。

使用方法

Assert命令はBoolean型の式を第一引数にとり、Falseであればイミディエイトウインドウにアサート失敗を告げるメッセージを出力する。また、オプションで第二引数の文字列をアサート失敗メッセージとすることもできる。

Never命令はAssertの逆で、Trueであればイミディエイトウインドウにメッセージを出力する。

Out命令は単にDebug.Printと同等である。

以下は使用例。

Sub hoge()
    Tester.Assert 1 = 2, "one is not two"
    Tester.Out "test message"
    Tester.Never 1 = 1, "one is one"
    Debug.Print "hoge"
End Sub

Debug.Assertと同様に失敗時にコードを停止させるには、TesterクラスのSTOP_ON_ASSERTION_FAILUREをTrueに設定する。

ただし、クラスモジュール内部で処理が停止してしまう。

このとき、Ctrl+Lで呼び出し履歴ウインドウを表示できるので、カーソルキーの↓で一つ下を選び、Enterで決定すると、

どこでコケたのかが分かる。

リリース時は、TesterクラスのVALIDをFALSEにするのを忘れずに。

VBA アサーションチェックとは

最近Twitterで何件か、Debug.Assertについて語られているのを見かけたので乗っかってみる。

Debug.Assertの使い方自体は以下で述べたので今回はその意義を中心に説明してみようと思う。
thom.hateblo.jp

アサートとは

Assertという英単語には、主張する・断言する・力説する・表明するといった意味がある。

例) "He asserted he is innocent." → 彼は無実を主張した。

Assertionはそれを名詞化したもので、そのまま主張・断言・力説・表明といった意味。

アサーション機能とは

プログラム言語におけるアサーション機能とは、
「ここはこうなるはずである」という主張・表明をコードとして記述するための命令文を指す。
VBAでは、Debug.Assertという命令が用意されている。

アサーションチェックとは

このアサーションを活用して、バグを炙り出すテクニックをアサーションチェックという。
具体的にどうやるのかは冒頭で紹介した記事を参照して欲しい。

大事なこと

Debug.Assertはあまり見慣れないためか、機能と挙動に着目されることが多い。
でも、そこで終わってはもったいない。

大事なのは、「何のための機能か」である。
挙動だけなら、ウォッチウインドウやIf文で代用できる。

あえてDebug.Assertを使うからには、それは「主張・表明」であって欲しいということ。

Ifやウォッチウインドウは、「どうなったらどうする」という記述はできるが、各ケースは中立でありそれ以上は語っていない。

一方、Debug.Assertは、「条件式の結果はTrueに帰結すべきであるし、当然そうなるはずだ、でなればバグだ」という強い主張を読み取ることができる。

まぁそんな気負わずにさくっと使ってもいいんだけど、原則としてAssertは主張・表明であるということを覚えておくと良い。

使用例

まずは王道のユニットテスト。
thom.hateblo.jp

それから、ループでブックの閉じ忘れを予防するアサーション。
thom.hateblo.jp

関数をリファクタリングした後の、同等性チェック。
thom.hateblo.jp

以上

VBA ユーザーフォームでDual Listboxを作成

今回紹介するのは、複数アイテムの選択でよく見かけるDual Listbox UI。

一応説明しておくと、左のリストからアイテムを選択し、右へ移動させ、最終的に右にあるものが選択したアイテムとして扱われるユーザーインターフェースだ。

構造はそれほど難しくないが、作ってみたら意外に手間だったので記事に残しておく。

フォームデザイン

各部のオブジェクト名は次のとおり設定する。

AvailableListBoxとSelectedListBoxには次の値を設定する。

BorderStyle	1 - fmBorderStyleSingle
MultiSelect	2 - fmMultiSelectExtended

その他、全コントロールのフォントをMeiryo UIに設定する。

TabIndexは次のように設定したが、適宜お好みで良いと思う。

コード

フォームモジュール DualListBoxForm のコード

このコードのポイントは外部から直接フォームをShowさせるのではなく、OpenForm関数の呼び出しによってフォームモジュール内部からShowさせていること。

通常はメインコードでモーダルフォームをShowし、フォーム操作の後にフォームをHideする。
そのフォームで選択された結果を取得するコードもメインコードに書かなければならない。
しかし今回の方法なら、モーダルフォームのクローズから状態取得までを関数に内包させることができ、メインコードが汚れずに済む。

Option Explicit
Public OKClicked As Boolean

Public Function OpenForm(string_collection As Collection, Optional caption_ As String = "Dual ListBox") As Collection
    Me.Caption = caption_
    Dim ret As Collection
    Dim s
    For Each s In string_collection
        AvailableListBox.AddItem s
    Next
    Me.Show
    If OKClicked Then
        Set ret = New Collection
        Dim i As Long
        For i = 0 To SelectedListBox.ListCount - 1
            ret.Add SelectedListBox.List(i)
        Next
    Else
        'ret keeps Nothing
    End If
    Set OpenForm = ret
    Unload Me
End Function

Private Sub AddButton_Click()
    MoveSelectedItems AvailableListBox, SelectedListBox
End Sub

Private Sub AvailableListBox_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    MoveSelectedItems AvailableListBox, SelectedListBox
End Sub

Private Sub RemoveButton_Click()
    MoveSelectedItems SelectedListBox, AvailableListBox
End Sub

Private Sub SelectedListBox_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    MoveSelectedItems SelectedListBox, AvailableListBox
End Sub

Private Sub AddAllButton_Click()
    MoveSelectedItems AvailableListBox, SelectedListBox, True
End Sub

Private Sub RemoveAllButton_Click()
    MoveSelectedItems SelectedListBox, AvailableListBox, True
End Sub

Private Sub OKButton_Click()
    OKClicked = True
    Me.Hide
End Sub

Private Sub CancelButton_Click()
    Me.Hide
End Sub

Private Sub MoveSelectedItems(from_list As MSForms.ListBox, to_list As MSForms.ListBox, Optional target_all As Boolean = False)
    Dim i As Long
    For i = from_list.ListCount - 1 To 0 Step -1
        If from_list.Selected(i) Or target_all Then
            Dim j As Long
            For j = 0 To to_list.ListCount - 1
                If to_list.List(j) >= from_list.List(i) Then
                    Exit For
                End If
            Next
            to_list.AddItem from_list.List(i), j
            from_list.RemoveItem i
        End If
    Next
End Sub

標準モジュールのコード

DualListBoxの選択結果をイミディエイトウインドウに出力するコードを書いてみた。
フォームモジュールのOpenForm関数にString型データの入ったコレクションを渡すとAvailableListに表示され、フォームを閉じるとSelectedListの内容がコレクションで返る仕組み。

Sub hoge()
    Dim c As Collection: Set c = New Collection
    For i = Asc("A") To Asc("E")
        c.Add Chr(i)
    Next

    'フォームを開き、操作結果を取得
    Set c = DualListBoxForm.OpenForm(c)
    
    If Not c Is Nothing Then
        For Each s In c
            Debug.Print s
        Next
    End If
End Sub

リストの準備と返ってきたリストの処理色々ごちゃごちゃやってるように見えるが、フォームからのデータ取得はたったの一行で済む。使い勝手はMsgBoxやInputBoxに近づいたと思う。

あとがき

実際に使ってみて、ボタンの並び順をちょっと失敗したかなと思った。
選択したものだけを移動したいときに、間違えて先頭にあるAddAllButtonを押してしまう。
Add, Remove, AddAll, RemoveAllの順の方が使いやすいかも。
でも記事書いちゃったのでこれはこれで。。

以上