【ExcelVBA】クソ長いファイルパスとか簡略表示したいから勝手に改行してくれ

Hey!! みんな元気してる！？？

私は！
今も！

元気してるぜ！？？

実はもうVBAなんてやめちまって
pythonに乗り移ろうなんて考えてたんだけども
仕事場で業務改善するのにウチはpythonむいてねぇって気が付いたんだぜ！
チクショーが！！
デスクトップアプリ作ろうにも起動重いし
何より身内に触れる奴がおらん！！
やっとVBA仲間が二人増えただけなんて、そんなことあるか！？？？？
しかも資料もデータも全部Excelで、しまいにゃ基幹システムからのデータ出力もExcelって、、、
どうかしてるぜっ！！

ただ、VBAでUserForm使うってなると
なかなかにむず痒い所に手が届かないんだよな！
チクショーが！！

今回の痒いところはこれだ！

だだ長い文字列をいい感じに折り返し改行してくれ！！

いや、一個ずつ区切ればええやん笑

そんなこと言うな！！

なんでVBA使って業務改善してんだ！！

仕事が面倒くさいからだろう！？？

そう！いちいちコード触るのすら面倒！！

早速コード紹介

ReturnMsg.VBA

Function ReturnMsg( _
    MsgComment As String, _
    ReturnLen As Long, _
    Optional Key As Variant = vbCrLf, _
    Optional MaximamRow As Long = 0, _
    Optional OutType As Boolean = False _
    ) As Variant
'ReturnLenおきにコメントに改行を入れてくれる関数


'変数Txtを文字列で繋いで運用するのに限界を感じたので、Txt配列で（要素＝１行）って感じで修正した。
'出力が配列になる。 それはそれでいいかなってことで、AryとStrの２個を用意した。

    '第１引数 MsgComment :改行を入れたい文字列
    '第２引数 ReturnLen  :改行を入れる文字数。（25 とするなら 26文字目が２行目となる）
    '第３引数 Key        :改行処理の優先文字。指定文字間の間で区切る場合は、その手前で区切るようにする。
    '第４引数 MaximamRow :最大行数。0は指定なしと同義。
    '                    設定行数を超える場合に設定行数の冒頭に … を付け、最後から(ReturnLen - 2) の文字を表示する。
    '
    '                    [例]  "AAABBBCCCDDDEEEFFFGGG", ReturnLen = 6, MaxRow = 3
    '                       MaxRow=0　の時　"AAABBB/CCCDDD/EEEFFF/GGG"
    '                       MaxRow=2  の時  "AAABBB/…FGGG
    '第５引数 OutType    :出力タイプ
    '                    False = StrAry 配列で出力
    '                    True  = StrBuf 文字列で出力 (改行コードは vbCrLf)
    

Dim Txt As Variant           '出力データの格納用 OutTypeによってString、Arrayのどちらでも使用する。
Dim StrAry(), RowCnt As Long '配列化しているときの要素格納用
Dim Buf As String            '引数MsgComment用のバッファ
Dim i, j                     'i が格納済みの行数。j が１行あたりの文字数
Dim MaxRow As Long           '引数MaximamRow用のバッファ
Dim RowEnd As String         '最終文字の取得用
Dim KeyWord As String        '引数Key用のバッファ



'最大行数MaxRowへ引数に応じた値を代入。
'MaximamRow=0 なら、メッセージの文字数分を設定(実質的に無限大)
If 0 < MaximamRow Then
    MaxRow = MaximamRow - 1
Else
    MaxRow = Len(MsgComment)
End If



'改行するメッセージをバッファへ代入
Buf = MsgComment
'改行するときの優先文字をバッファへ代入
KeyWord = Key

i = 1 'デバッグ用 行数カウント

'初期化
RowCnt = 0 'Txt配列用カウンタ
ReDim StrAry(RowCnt)

Do While Len(Buf) > ReturnLen
    ReDim Preserve StrAry(RowCnt)
    
    If RowCnt < MaxRow Then
        'MaxRow超えていないとき
        j = InStrRev(Buf, KeyWord, Start:=ReturnLen)
        If j = 0 Then
            j = ReturnLen
        End If
        
        StrAry(RowCnt) = Left(Buf, j)
        
        Debug.Print (i & ":" & vbCrLf & StrAry(RowCnt))
        Debug.Print ("")
        i = i + 1
        RowCnt = RowCnt + 1
        
        Buf = Replace(Buf, Left(Buf, j), "")
        
    Else
        'MaxRow超えた時
        
        If 3 < ReturnLen Then
            '改行文字数が3文字以上なら
            
            StrAry(RowCnt) = "…" & Right(Buf, ReturnLen - 3)
            Debug.Print (i & ":" & vbCrLf & StrAry(RowCnt))
            Debug.Print ("")
            i = i + 1
            RowCnt = RowCnt + 1
        Else
            '改行文字数が2文字以下なら
            
            If UBound(StrAry) <= 2 Then
                '全部で行数が2行しかない場合
                '一つ手前を消すにしても行が無いので、最終行へ…を代入する。
                StrAry(RowCnt) = "…"
                Debug.Print (i & ":" & vbCrLf & StrAry(RowCnt))
                Debug.Print ("")
                i = i + 1
                RowCnt = RowCnt + 1
            Else
                '全部で行数が3行以上あれば
                '…が入りきらないので最終行の一つ手前を…にして最終行を表示させる。
                StrAry(RowCnt - 1) = "…"
                StrAry(RowCnt) = Right(MsgComment, ReturnLen)
                Debug.Print (i & ":" & vbCrLf & StrAry(RowCnt - 1) & vbCrLf & StrAry(RowCnt))
                Debug.Print ("")
                i = i + 1
                RowCnt = RowCnt + 1
            End If
        End If
        
        'ReturnMsgAry = StrAry
        GoTo OutType_Select

    End If
    
Loop

ReDim Preserve StrAry(RowCnt)
StrAry(RowCnt) = Buf
Debug.Print (i & ":" & vbCrLf & StrAry(RowCnt))
Debug.Print ("")



OutType_Select:
    '出力タイプを切り替える
    If OutType Then
        'OutType = Trueなら
        '文字列で出力する。改行コードは vbCrLf で固定。変更する場合は下記 '***改行 の箇所を書き換えるとよい
        Txt = Join(StrAry, vbCrLf)
    Else
        'OutType = Falseなら
        '配列で出力する。
        Txt = StrAry
    End If
    
    '処理終了
    ReturnMsg = Txt

End Function

いやぁー。長い。
こんな処理、pythonだともっと短く済むのに。。。

では仕様について、コードブロック冒頭の引数メモと[例]にもあるが、、

どんな感じか色々パターン別でご紹介。

パターン1

Rtn_1 = ReturnMsg("AAABBBCCCDDDEEEFFFGGG", ReturnLen = 6)

この為だけならこんな長い関数作らんけどね？
そーわいっても、オーソドックスな使い方も出来た方が良いでしょう。

はい、こーなります。

Rtn_1

AAABBB
CCCDDD
EEEFFF
GGG

MaxRowは opticalなので
MaxRow=0 最大行指定なし
なので、文字列終わるまで改行入れたるでぇー。

お次は、、、

パターン2

Rtn_2 = ReturnMsg("AAABBBCCCDDDEEEFFFGGG", ReturnLen = 6, MaxRow = 3)

かーらーのーー

Rtn_2

AAABBB
CCCDDD
…FGGG

あーれれー？
最終行が一文字足りないぞぉー？？

いや、ワザとですから笑
これしないと中略してるのが気付きにくいんでさぁ。
デバッグ中に 見にきぃわ！！ ってなって
こういう、仕様にしてみました。

中略する事で、クソ長いファイルパスも
Userform中のLabelの大きさを変える事なく動的に値をいじることが出来るのだ！！
もはやこの為に作ったと言っても過言ではない関数だ！！

しかし！！　これに留まらない！！

こいつの真価はこれだけじゃないのだ。。。

引数:Key と OutTypeとは！？？

ふふふふふ｡｡｡

じつはこの関数、、使い道を変えれば
様々な文字列をcsv形式のように扱えるのだ！！

たとえばこれ！！
・ABCD・DEF・GHIJ・KLM

これを、・で区切って項目を取得。
OutType=Falseで配列で結果出力してみよう！

パターン3

Rtn_3 = ReturnMsg("・ABCD・DEF・GHIJ・KLM", ReturnLen = 5, Key = "・", OutType = False)

からの、どーーん！！

Rtn_3

Rtn(0) 'ABCD
Rtn(1) 'DEF
Rtn(2) 'GHIJ
Rtn(3) 'KLM

なにがどうだって言うんだ
だと？？

これを Listbox.listへ代入 したりするとか
他のプロシージャでいじくり回す とかするのさ！！
(つまり使い道は人任せ)

最後にまぁ、なんだ、、

意外とこういった文字列を配列分割したりとかって
VBAで遭遇率高い割に処理だるいんだよねー。

でも、こいつがあれば大抵は何とかなるから大丈夫っつー訳よ。
大した事はしていないけども、地味に記述量減って助かるって気付くのは
作ってる業務改善案が形になってきた時｡｡｡
まさに縁の下の力持ちな関数をご紹介させて貰いました。

※拙い文章に嫌悪感を抱かれた方、また胸焼けや吐き気を覚えた方へ心からお詫び申し上げますが、
堅苦しい文を書くのは性に合わないもので、今後はより一層フランクに、ナチュラルボデーな投稿を心がけて参りますので
暖かく見守って下されば幸いです。
また、投稿内容へのご質問やご意見について
(こんな内容に返す言葉もないでしょうが。)
コメント頂ければ、時間見つけて精一杯お答え致しますので
よろしくお願い致します。