ShowMessageMacroRegistShapes

'ShowMessageMacroRegistShapes・・・元場所：IkiAddin.ModOther
'ExtractArray2D              ・・・元場所：IkiAddin.ModArray
'IsArray2D                   ・・・元場所：IkiAddin.ModArray
'IsArray2DStart1             ・・・元場所：IkiAddin.ModArray
'DPA                         ・・・元場所：IkiAddin.ModImmediate
'GetDimensionArray           ・・・元場所：IkiAddin.ModArray
'DebugPrintArray1D           ・・・元場所：IkiAddin.ModImmediate
'DebugPrintArray             ・・・元場所：IkiAddin.ModImmediate
'Make__ArrayWithNum          ・・・元場所：IkiAddin.ModImmediate
'Make__OutputStr             ・・・元場所：IkiAddin.ModImmediate
'Conv__StrShorter            ・・・元場所：IkiAddin.ModImmediate
'Cal__TotalByteList          ・・・元場所：IkiAddin.ModImmediate
'DebugPrintArray2D           ・・・元場所：IkiAddin.ModImmediate



Public Sub ShowMessageMacroRegistShapes()
'シェイプに登録してあるマクロ一覧を表示する
'20220610
'http://blog.livedoor.jp/aero_iki-jibundakemacro/archives/35190423.html

    Dim Book  As Workbook: Set Book = ActiveWorkbook
    Dim Sheet As Worksheet
    Dim Shape As Object
    Dim Macro As String
    
    Dim Output As Variant: ReDim Output(1 To 5000, 1 To 5) '1:シート名,2:シェイプのテキスト,3:シェイプの種類,4:セル位置,5:登録マクロ
    Dim K      As Long: K = 1
    Output(1, 1) = "シート"
    Output(1, 2) = "テキスト"
    Output(1, 3) = "シェイプ種類"
    Output(1, 4) = "セル位置"
    Output(1, 5) = "登録マクロ"
    
    For Each Sheet In Book.Sheets
        For Each Shape In Sheet.Shapes
            If Shape.OnAction <> "" Then
                K = K + 1
                Output(K, 1) = Sheet.Name
                On Error Resume Next
                Output(K, 2) = Shape.TextFrame2.TextRange.Text
                If Output(K, 2) = "" Then
                    Output(K, 2) = Shape.DrawingObject.Caption
                End If
                On Error GoTo -1
                
                Output(K, 3) = TypeName(Shape)
                Output(K, 4) = Shape.topLeftCell.Address(False, False)
                Output(K, 5) = Shape.OnAction
            End If
        Next
    Next
    
    Output = ExtractArray2D(Output, 1, 1, K)
'    Call CA(Output)
    DPA Output
    
'    Dim ArrayStr As String: ArrayStr = ConvArray2DToStr(Output)
'
'    With frmMessageText
'        .frmCaption = "マクロが登録されたシェイプ一覧"
'        .Lbl = "表示メッセージは配列としてクリップボードにも格納しています"
'        .Text = ArrayStr
''        .FontSize = 14
''        .TextHeight = 400
''        .TextWidth = 400
'        .AutoSize = True
'        .Show
'    End With
    
End Sub

Private Function ExtractArray2D(ByRef Array2D As Variant, _
                     Optional ByRef StartRow As Long = 1, _
                     Optional ByRef StartCol As Long = 1, _
                       Optional ByRef EndRow As Long = 0, _
                       Optional ByRef EndCol As Long = 0) _
                                             As Variant
                       
'二次元配列の指定範囲を配列として抽出する
'20210917
'20211102 抽出範囲をデフォルト値設定が可能に
'20220915 要素がオブジェクトでも対応可能
'https://www.softex-celware.com/post/extractarray2d

'引数
'Array2D   ・・・二次元配列
'[StartRow]・・・抽出範囲の開始行番号/省略なら1
'[StartCol]・・・抽出範囲の開始列番号/省略なら1
'[EndRow]  ・・・抽出範囲の終了行番号/省略なら最大行番号
'[EndCol]  ・・・抽出範囲の終了列番号/省略なら最大列番号
                                  
'返り値
'指定の範囲が抽出された二次元配列
                                  
    '引数チェック
    If IsArray2D(Array2D) = False Then Exit Function       '二次元配列かチェック
    If IsArray2DStart1(Array2D) = False Then Exit Function '開始要素番号が1かチェック
    
    Dim I As Long
    Dim J As Long
    Dim N As Long: N = UBound(Array2D, 1) '行数
    Dim M As Long: M = UBound(Array2D, 2) '列数
    
    '終了行、列の設定
    If EndRow = 0 Then
        EndRow = N
    End If
    
    If EndCol = 0 Then
        EndCol = M
    End If
    
    If StartRow > EndRow Then
        MsgBox "抽出範囲の開始行「StartRow」は、" & _
               "終了行「EndRow」以下でなければなりません", vbExclamation
        Stop
        Exit Function
    ElseIf StartCol > EndCol Then
        MsgBox "抽出範囲の開始列「StartCol」は、" & _
                "終了列「EndCol」以下でなければなりません", vbExclamation
        Stop
        Exit Function
    ElseIf StartRow < 1 Then
        MsgBox "抽出範囲の開始行「StartRow」は" & _
               "1以上の値を入れてください", vbExclamation
        Stop
        Exit Function
    ElseIf StartCol < 1 Then
        MsgBox "抽出範囲の開始列「StartCol」は" & _
               "1以上の値を入れてください", vbExclamation
        Stop
        Exit Function
    ElseIf EndRow > N Then
        MsgBox "抽出範囲の終了行「EndRow」は" & _
               "抽出元の二次元配列の行数" & N & _
               "以下の値を入れてください", vbExclamation
        Stop
        Exit Function
    ElseIf EndCol > M Then
        MsgBox "抽出範囲の終了列「EndCol」は" & _
               "抽出元の二次元配列の列数" & M & _
               "以下の値を入れてください", vbExclamation
        Stop
        Exit Function
    End If
    
    '処理
    Dim Output As Variant
    ReDim Output(1 To EndRow - StartRow + 1, _
                 1 To EndCol - StartCol + 1)
    
    For I = StartRow To EndRow
        For J = StartCol To EndCol
            If IsObject(Array2D(I, J)) = True Then '20220915
                Set Output(I - StartRow + 1, J - StartCol + 1) _
                    = Array2D(I, J)
            Else
                Output(I - StartRow + 1, J - StartCol + 1) _
                = Array2D(I, J)
            End If
        Next J
    Next I
    
    '出力
    ExtractArray2D = Output
    
End Function

Private Function IsArray2D(ByRef Array2D As Variant, _
               Optional ByRef ArrayName As String = "Array2D") _
                                        As Boolean
'入力配列が二次元配列かどうかチェックする
'20210804
'20220309 変数名変更
'20241230 Functionプロシージャにして判定結果を返す
'https://www.softex-celware.com/post/isarray1d

'引数
'Array2D    ・・・チェックする配列
'[ArrayName]・・・エラーメッセージで表示する時の名前

    On Error Resume Next
    Dim Dummy2 As Long: Dummy2 = UBound(Array2D, 2)
    Dim Dummy3 As Long: Dummy3 = UBound(Array2D, 3)
    On Error GoTo 0
    If Dummy2 = 0 Or Dummy3 <> 0 Then
        MsgBox ArrayName & "は二次元配列を入力してください", vbExclamation
        Stop 'エラーを確認するために一度停止する
        Exit Function 'Falseが返ってくる
    End If
    
    '出力
    IsArray2D = True
    
End Function

Private Function IsArray2DStart1(ByRef Array2D As Variant, _
                     Optional ByRef ArrayName As String = "Array2D") _
                                              As Boolean
'入力二次元配列の開始番号が1かどうかチェックする
'20210804
'20220309 変数名変更
'20241230 Functionプロシージャにして判定結果を返す
'https://www.softex-celware.com/post/isarray1d

'引数
'Array2D    ・・・チェックする二次元配列
'[ArrayName]・・・エラーメッセージで表示する時の名前

    If LBound(Array2D, 1) <> 1 Or LBound(Array2D, 2) <> 1 Then
        MsgBox ArrayName & "の開始要素番号は1にしてください", vbExclamation
        Stop 'エラーを確認するために一度停止する
        Exit Function 'Falseが返ってくる
    End If
    
    '出力
    IsArray2DStart1 = True

End Function

Private Sub DPA(ByVal ShowArray As Variant, _
       Optional ByRef StartRow As Long, _
         Optional ByRef EndRow As Long, _
      Optional ByRef StrLength As Long)
      
'配列をイミディエイトウィンドウに見やすく表示する
'20210428
'20211129 大幅改良
'20231222 リファクタリング
'https://www.softex-celware.com/post/__dpa

'引数
'ShowArray   ・・・表示する配列(一次元配列か二次元配列)
'[StartRow]  ・・・行で表示範囲を指定する場合の開始行/省略なら1行目から表示
'[EndRow]    ・・・行で表示範囲を指定する場合の終了行/省略なら最大行まで表示
'[StrLength] ・・・各要素の表示する文字列長さ最大/省略なら文字列全体表示
    
    '配列の次元計算
    Dim Dimension As Long: Dimension = GetDimensionArray(ShowArray)
    
    'イミディエイトウィンドウに表示
    Select Case Dimension
        Case 1
            '一次元配列の場合
            Call DebugPrintArray1D(ShowArray, StartRow, EndRow, StrLength)
        Case 2
            '二次元配列の場合
            Call DebugPrintArray2D(ShowArray, StartRow, EndRow, StrLength)
        Case Else
            MsgBox "一次元配列か二次元配列を入力してください", vbExclamation
            Exit Sub
    End Select
    
End Sub

Private Function GetDimensionArray(ByRef Array_ As Variant)
'配列の次元数を返す
'配列でない場合は0を返す

'引数
'Array_・・・配列

    '処理
    Dim Output As Long
    Dim Tmp    As Variant
    Dim K      As Long
                             
    If VarType(Array_) < vbArray Then
        '配列でない場合
        Output = 0
    Else
        K = 0
        On Error Resume Next
        Do
            K = K + 1
            Tmp = 0
            Tmp = UBound(Array_, K) 'K次元要素数が存在しないならエラーとなる
            
            If Tmp = 0 Then
                'エラーならTmpがEmptyなのでK-1が次元で確定
                Output = K - 1
                Exit Do
            End If
        Loop
        On Error GoTo 0
    End If
    
    '出力
    GetDimensionArray = Output
    
End Function

Private Sub DebugPrintArray1D(ByVal Array1D As Variant, _
                    Optional ByRef StartRow As Long, _
                      Optional ByRef EndRow As Long, _
                   Optional ByRef StrLength As Long)
'一次元配列をイミディエイトウィンドウに見やすく表示する
'20211129
'20220224 行、列番号を表示、非表示切替れるように
'20231222 リファクタリング

'引数
'Array1D     ・・・表示する一次元配列
'[StartRow]  ・・・行で表示範囲を指定する場合の開始行/省略なら1行目から表示
'[EndRow]    ・・・行で表示範囲を指定する場合の終了行/省略なら最大行まで表示
'[StrLength] ・・・各要素の表示する文字列長さ最大/省略なら文字列全体表示
    
    '一次元配列を二次元配列に変換して「DebugPrintArray2D」を利用して表示する
    
    '要素番号の最小最大を取得
    Dim MinRow As Long: MinRow = LBound(Array1D, 1) '配列の番号（インデックス）の最小
    Dim MaxRow As Long: MaxRow = UBound(Array1D, 1) '配列の番号（インデックス）の最大
    
    '二次元配列に変換する
    Dim ShowArray As Variant: ReDim ShowArray(MinRow To MaxRow, 1 To 1)
    Dim I         As Long
    Dim N         As Long
    For I = MinRow To MaxRow
        If IsObject(Array1D(I)) = True Then 'オブジェクトの場合はオブジェクトとして格納
            Set ShowArray(I, 1) = Array1D(I)
        Else
            ShowArray(I, 1) = Array1D(I)
        End If
    Next I
    
    '配列のサイズ表示
    Debug.Print "配列サイズ(" & MinRow & " To " & MaxRow & ")"
    
    'イミディエイトウィンドウに表示
    Call DebugPrintArray(ShowArray, StartRow, EndRow, StrLength)
    
End Sub

Private Sub DebugPrintArray(ByVal ShowArray As Variant, _
                    Optional ByRef StartRow As Long, _
                      Optional ByRef EndRow As Long, _
                   Optional ByRef StrLength As Long)
'二次元配列をイミディエイトウィンドウに見やすく表示する

'20201023
'20211018 入力した配列がHairetu(1 to 1)の一次元配列の場合でも処理できるように修正
'20211123 引数名などを変更
'20211129 二次元配列出力専用に変更。配列のサイズ表示。行表示範囲指定が可能に。オブジェクト型が含まれても対応可能
'20220224 行、列番号を表示、非表示切替れるように
'20220913 要素内にエラー値が含まれている場合の処理追加
'20231222 リファクタリング
'20240202 200行を超える場合の高速化処理追加

'元の配列
'[[A,B,C],
' [あ,い,う]]
'↓
'イミディエイトウィンドウに出力結果
' |1 |2 |3 |
'1|A |B |C |
'2|あ|い|う|

'引数
'ShowArray  ・・・表示する二次元配列
'[StartRow] ・・・行で表示範囲を指定する場合の開始行
'                 省略なら1行目から表示
'[EndRow]   ・・・行で表示範囲を指定する場合の終了行
'                 省略なら最大行まで表示
'[StrLength]・・・各要素の表示する文字列長さ最大
'                 省略なら文字列全体表示

    '※※※※※※※※※※※※※※※※※※※※※※※※※※※
    '入力引数の処理
       
    '配列の要素数を取得
    Dim MinRow As Long: MinRow = LBound(ShowArray, 1) '開始行番号
    Dim MaxRow As Long: MaxRow = UBound(ShowArray, 1) '終了行番号
    
    '※※※※※※※※※※※※※※※※※※※※※※※※※※
    '行・列番号が付いた配列を作成
    Dim Dummy As Variant
    Dummy = Make__ArrayWithNum(ShowArray, StartRow, EndRow)
    
    '行・列番号付の配列
    Dim ArrayWithNum As Variant: ArrayWithNum = Dummy(1)
    
    '配列の要素にオブジェクト型が含まれているかの判定
    Dim JudgeObject  As Boolean: JudgeObject = Dummy(2)
    
    '配列の要素に配列が含まれているかの判定
    Dim JudgeArray   As Boolean: JudgeArray = Dummy(3)
    
    '配列の要素にエラー値が含まれているかの判定
    Dim JudgeError   As Boolean: JudgeError = Dummy(4)

    '※※※※※※※※※※※※※※※※※※※※※※※※※※※
    'イミディエイトウィンドウに表示する文字列を作成
    Dummy = Make__OutputStr(ArrayWithNum, StrLength, StartRow, EndRow)
    
    'イミディエイトウィンドウに表示する文字列
    Dim OutputStr    As String: OutputStr = Dummy(1)
    
    '表示範囲が200行を超えるかの判定
    Dim JudgeOver200 As Boolean: JudgeOver200 = Dummy(2)
    
    ''※※※※※※※※※※※※※※※※※※※※※※※※※※※
    'イミディエイトウィンドウに表示
    Debug.Print OutputStr
    
    '例外の要素があったことを表示
    If JudgeOver200 = True Then
        Debug.Print "※※縦要素数が200を超えたので" & _
                    "前後だけを表示しました！！※※"
    End If
    
    If JudgeObject = True Then
        Debug.Print "※※配列内にオブジェクト型が" & _
                    "含まれています！！※※"
    End If
    
    If JudgeArray = True Then
        Debug.Print "※※配列内に配列が含まれています！！※※"
    End If
    
    If JudgeError = True Then
        Debug.Print "※※配列内にエラー値が含まれています！！※※"
    End If
    
End Sub

Private Function Make__ArrayWithNum(ByRef ShowArray As Variant, _
                                     ByRef StartRow As Long, _
                                       ByRef EndRow As Long)
'行・列番号がついた二次元配列を作成する
    
'元の配列
'[[A,B,C],
' [あ,い,う]]
'↓
'作成する配列
' |1 |2 |3 |
'1|A |B |C |
'2|あ|い|う|

'引数
'ShowArray・・・二次元配列

    '部分表示かどうかの判定
    Dim JudgePartially As Boolean
    If StartRow = 0 And EndRow = 0 Then
        JudgePartially = False
    Else
        JudgePartially = True
    End If
    
    '200行を超える場合の前後表示最大表示行数
    Const MaxRowOver200 As Long = 10

    '配列の要素数を取得
    Dim MinRow As Long: MinRow = LBound(ShowArray, 1) '開始行番号
    Dim MaxRow As Long: MaxRow = UBound(ShowArray, 1) '終了行番号
    Dim MinCol As Long: MinCol = LBound(ShowArray, 2) '開始列番号
    Dim MaxCol As Long: MaxCol = UBound(ShowArray, 2) '終了行番号
    
    '行・列番号付きの配列の準備
    Dim RowCount     As Long:    RowCount = MaxRow - MinRow + 1 '行数
    Dim ColCount     As Long:    ColCount = MaxCol - MinCol + 1 '列数
    Dim ArrayWithNum As Variant
    ReDim ArrayWithNum(1 To RowCount + 1, 1 To ColCount + 1)
    '(行・列番号の分で"+1"する)
    
    Dim I     As Long
    Dim J     As Long
    Dim Row   As Long '対象の配列(ShowArray)での行番号
    Dim Col   As Long '対象の配列(ShowArray)での列番号
    Dim Value As String
    
    '配列の要素内に例外が含まれていた場合の判定
    '配列の要素にオブジェクト型が含まれているかどうか判定
    Dim JudgeObject As Boolean: JudgeObject = False
    
    '配列の要素に配列が含まれているかどうか判定
    Dim JudgeArray  As Boolean: JudgeArray = False
    
    '配列の要素にエラー値が含まれているかどうか判定
    Dim JudgeError  As Boolean: JudgeError = False
    
    For I = 1 To RowCount
        If JudgePartially = False And RowCount > 200 And MaxRowOver200 < I And I < RowCount - MaxRowOver200 Then
            '何もしない
        Else
            If JudgePartially = True And (I < StartRow Or EndRow < I) Then
                '表示範囲外は処理しない
            Else
                ArrayWithNum(I + 1, 1) = MinRow + I - 1 '行番号
                Row = I - 1 + MinRow
                
                For J = 1 To ColCount
                    ArrayWithNum(1, J + 1) = MinCol + J - 1 '列番号
                    Col = J - 1 + MinCol
                    
                    '例外の要素か判定
                    If IsObject(ShowArray(Row, Col)) = True Then
                        'オブジェクト型が配列に入っている場合
                        '→その型名を表示する
                        Value = TypeName(ShowArray(Row, Col)) & "型"
                        JudgeObject = True
                        
                    ElseIf IsArray(ShowArray(Row, Col)) Then
                        '配列が配列の中に入っている場合
                        '→「配列」と表示
                        Value = "配列"
                        JudgeArray = True
                        
                    ElseIf IsError(ShowArray(Row, Col)) Then
                        '値がエラーの場合
                        '→「エラー」と表示
                        Value = "エラー"
                        JudgeError = True
                        
                    Else
        '                On Error Resume Next
                        Value = ShowArray(Row, Col)
        '                On Error GoTo 0
                    End If
                    
                    ArrayWithNum(I + 1, J + 1) = Value
                Next J
            End If
        End If
    Next I
    
    '出力
    Dim Output(1 To 4) As Variant
    Output(1) = ArrayWithNum
    Output(2) = JudgeObject
    Output(3) = JudgeArray
    Output(4) = JudgeError
    
    Make__ArrayWithNum = Output
    
End Function

Private Function Make__OutputStr(ByRef ArrayWithNum As Variant, _
                                    ByRef StrLength As Long, _
                                     ByRef StartRow As Long, _
                                       ByRef EndRow As Long) _
                                                    As Variant
'イミディエイトウィンドウに表示する文字列を作成
'各列の幅を同じに整えるため文字列長さとその各列の最大値を計算する。
'表示行数が200行を超える場合は前後10行だけ表示する

'元の配列
'[[,1,2,3],
' [1,A,B,C],
' [2,あ,い,う]]
'↓
'作成する文字列(各行は改行で結合してある)
' |1 |2 |3 |
'1|A |B |C |
'2|あ|い|う|

'引数
'ArrayWithNum ・・・行・列番号付き配列
'StartRow     ・・・行で表示範囲を指定する場合の開始行
'EndRow       ・・・行で表示範囲を指定する場合の終了行

    '部分表示かどうかの判定
    Dim JudgePartially As Boolean
    If StartRow = 0 And EndRow = 0 Then
        JudgePartially = False
    Else
        JudgePartially = True
    End If

    '各列にの間の仕切り文字
    Const DelimiterStr  As String = "|"
    
    '200行を超える場合の前後表示最大表示行数
    Const MaxRowOver200 As Long = 10

    Dim I As Long
    Dim J As Long
    Dim N As Long: N = UBound(ArrayWithNum, 1) '行数
    Dim M As Long: M = UBound(ArrayWithNum, 2) '列数
    
    Dim TmpStr As String
                                    
    '各要素の文字列の長さを格納する二次元配列
    Dim StrLentghList     As Variant
    ReDim StrLentghList(1 To N, 1 To M)
    
    '各列での文字列長さの最大値を格納
    Dim MaxStrLengthList  As Variant
    ReDim MaxStrLengthList(1 To M)
    
    '※※※※※※※※※※※※※※※※※※※※※※※※※※
    '文字列の長さの調整と、文字列長さの計算
    For J = 1 To M
        For I = 1 To N
            If JudgePartially = False And N > 200 And N - 1 > MaxRowOver200 And MaxRowOver200 + 1 < I And I < N - MaxRowOver200 Then
                '何もしない
            Else
                If JudgePartially = True And I <> 1 And (I < StartRow + 1 Or EndRow + 1 < I) Then
                    '表示範囲外は処理しない
                Else
                    TmpStr = ArrayWithNum(I, J)
                    If J > 1 And StrLength <> 0 Then
                        '最大表示長さが指定されている場合は文字列長さを調整
                        '1列目(J=1)はそのままにする
                        TmpStr = Conv__StrShorter(TmpStr, StrLength)
                        ArrayWithNum(I, J) = TmpStr
                    End If
                    
                    '全角と半角を区別して長さを計算する。
                    StrLentghList(I, J) = LenB(StrConv(TmpStr, vbFromUnicode))
                    MaxStrLengthList(J) = _
                        WorksheetFunction.Max(MaxStrLengthList(J), _
                                              StrLentghList(I, J))
                End If
            End If
        Next I
    Next J
    
    '※※※※※※※※※※※※※※※※※※※※※※※※※※※
    'イミディエイトウィンドウに表示するために
    '" "(半角スペース)を追加して文字列長さを同じにする。
    
    '" "（半角スペース）を文字列に追加して
    '各列で文字列長さを同じにした文字列を格納
    
    Dim SameLengthStrList As Variant
    ReDim SameLengthStrList(1 To N)
    
    Dim TmpStrList_1Row As Variant
    ReDim TmpStrList_1Row(1 To M)
    
    Dim TmpStrLength As Long
    
    For I = 1 To N
        If JudgePartially = False And N > 200 And MaxRowOver200 + 1 < I And I < N - MaxRowOver200 Then
            '何もしない
        Else
            If JudgePartially = True And I <> 1 And (I < StartRow + 1 Or EndRow + 1 < I) Then
                '表示範囲外は処理しない
            Else
                For J = 1 To M
                    'その列の最大文字列長さ
                    TmpStrLength = MaxStrLengthList(J)
                    
                    '（最大文字数-文字数）の分" "（半角スペース）
                    'を後ろにくっつける。
                    TmpStrList_1Row(J) = ArrayWithNum(I, J) & _
                        String(TmpStrLength - StrLentghList(I, J), " ")
                Next J
                SameLengthStrList(I) = TmpStrList_1Row
            End If
        End If
    Next I
            
    '※※※※※※※※※※※※※※※※※※※※※※※※※※※
    'イミディエイトウィンドウに表示する文字列を作成
    '200行を超える場合/超えない場合/表示範囲が指定されている場合/
    'の3パターンで場合分け
    
    'イミディエイトウィンドウに表示する文字列
    Dim OutputStr     As String: OutputStr = ""
    
    '要素数が200を超えるかどうかの判定
    Dim JudgeOver200  As Boolean: JudgeOver200 = False
    
    If StartRow = 0 And EndRow = 0 Then
        '開始行、終了行が指定されていない場合
        
        If N > 200 Then '200行を超える場合は前後だけを表示する
            JudgeOver200 = True
            For I = 1 To MaxRowOver200 + 1
                OutputStr = OutputStr & _
                            Join(SameLengthStrList(I), DelimiterStr)
                OutputStr = OutputStr & vbCrLf
            Next I
            
            '途中に省略していることを示す「…」を表示
            OutputStr = OutputStr & "…" & vbCrLf
            
            For I = N - MaxRowOver200 To N
                OutputStr = OutputStr & _
                            Join(SameLengthStrList(I), DelimiterStr)
                OutputStr = OutputStr & vbCrLf
            Next I
        Else
            '200行を超えない場合は通常表示
            For I = 1 To N
                OutputStr = OutputStr & _
                            Join(SameLengthStrList(I), DelimiterStr)
                OutputStr = OutputStr & vbCrLf
            Next I
        End If
    Else
        '開始行、終了行が指定されている場合
        OutputStr = OutputStr & _
                    Join(SameLengthStrList(1), DelimiterStr)
        OutputStr = OutputStr & vbCrLf
        
        '途中に省略していることを示す「…」を表示
        If StartRow > 1 Then
            OutputStr = OutputStr & "…" & vbCrLf
        End If
       
        For I = StartRow + 1 To EndRow + 1
            OutputStr = OutputStr & _
                        Join(SameLengthStrList(I), DelimiterStr)
            OutputStr = OutputStr & vbCrLf
        Next I
    
        If EndRow + 1 < N Then
            OutputStr = OutputStr & "…" & vbCrLf  '非表示行の明示
        End If
    End If
    
    '※※※※※※※※※※※※※※※※※※※※※※※※※※
    '出力
    Dim Output(1 To 2) As Variant
    Output(1) = OutputStr
    Output(2) = JudgeOver200
    
    Make__OutputStr = Output
    
End Function

Private Function Conv__StrShorter(ByRef Str As String, _
                              ByRef ByteNum As Long) _
                                            As String
'文字列を指定省略バイト文字数までの長さで省略する。
'省略された文字列の最後の文字は"."に変更する。
'例：Str = "あいうえ" , ByteNum = 6 … 出力 = "あい.."
'例：Str = "あいうえ" , ByteNum = 7 … 出力 = "あいう."
'例：Str = "あいXXえ" , ByteNum = 6 … 出力 = "あいX."
'例：Str = "あいXXえ" , ByteNum = 7 … 出力 = "あいXX."
        
'引数
'Str    ・・・文字列
'ByteNum・・・バイト数
        
    '処理
    Dim OriginByte As Long '入力した文字列「Str」のバイト文字数
    OriginByte = LenB(StrConv(Str, vbFromUnicode))
    
    Dim I             As Long
    Dim N             As Long
    Dim Output        As String
    Dim TotalByteList As Variant
    Dim TmpStr        As String
    Const AddStr As String = "."
    
    If OriginByte <= ByteNum Then
        '「Str」のバイト文字数計算が
        '省略するバイト文字数以下なら省略はしない
        Output = Str
        
    Else
        TotalByteList = Cal__TotalByteList(Str)
        
        N = Len(Str)
        For I = 1 To N
            TmpStr = Mid(Str, I, 1)
            If TotalByteList(I) < ByteNum Then
                Output = Output & TmpStr
                
            ElseIf TotalByteList(I) = ByteNum Then
                If LenB(StrConv(TmpStr, vbFromUnicode)) = 1 Then
                    '例：Str = "あいうえ"
                    '→ ByteNum = 6 ,TotalByteList(3) = 6
                    '→ Output = "あい.."
                    Output = Output & AddStr
                Else
                    '例：Str = "あいXXえ"
                    '→ ByteNum = 6 ,TotalByteList(4) = 6
                    '→ Output = "あいX."
                    Output = Output & AddStr & AddStr
                End If
                
                Exit For
                
            ElseIf TotalByteList(I) > ByteNum Then
                '例：Str = "あいうえ"
                '→ ByteNum = 7 ,TotalByteList(4) = 8
                '→ Output = "あいう."
                Output = Output & AddStr
                Exit For
                
            End If
        Next I
        
    End If
        
    '出力
    Conv__StrShorter = Output
    
End Function

Private Function Cal__TotalByteList(ByRef Str As String) As Variant
'文字列を1文字ずつに分解して、各文字のバイト文字長を計算し、
'その累計値を計算する。

'例：Str="新型EKワゴン"
'出力→Output = (2,4,5,6,8,10,12)
    
    '処理
    Dim StrCount As Long: StrCount = Len(Str)
    Dim I        As Long
    Dim TmpStr   As String
    Dim Output   As Variant: ReDim Output(1 To StrCount)
    
    For I = 1 To StrCount
        TmpStr = Mid(Str, I, 1)
        If I = 1 Then
            Output(I) = LenB(StrConv(TmpStr, vbFromUnicode))
        Else
            Output(I) = LenB(StrConv(TmpStr, vbFromUnicode)) _
                        + Output(I - 1)
        End If
    Next I
    
    '出力
    Cal__TotalByteList = Output
    
End Function

Private Sub DebugPrintArray2D(ByVal ShowArray As Variant, _
                      Optional ByRef StartRow As Long, _
                        Optional ByRef EndRow As Long, _
                     Optional ByRef StrLength As Long)
'20231222 リファクタリング
    
    '配列の要素数を取得
    Dim MinRow As Long: MinRow = LBound(ShowArray, 1) '配列の縦番号（インデックス）の最小
    Dim MaxRow As Long: MaxRow = UBound(ShowArray, 1) '配列の縦番号（インデックス）の最大
    Dim MinCol As Long: MinCol = LBound(ShowArray, 2) '配列の横番号（インデックス）の最小
    Dim MaxCol As Long: MaxCol = UBound(ShowArray, 2) '配列の横番号（インデックス）の最大
    
    '配列のサイズ表示
    Debug.Print "配列サイズ(" & MinRow & " To " & MaxRow & ", " & MinCol & " To " & MaxCol & ")"
    
    'イミディエイトウィンドウに表示
    Call DebugPrintArray(ShowArray, StartRow, EndRow, StrLength)
    
End Sub