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で遭遇率高い割に処理だるいんだよねー。

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

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