Drawのﾃｰﾌﾞﾙに最後の列を追加2

こちらの続きです。
Drawのﾃｰﾌﾞﾙに最後の列を追加 - C#ATIA

前回のﾏｸﾛ、ちょっとﾀﾞﾒなんです。
ｾﾙの文字だけのｺﾋﾟｰだったので、ﾌｫﾝﾄのﾎﾞｰﾙﾄﾞ等が正しくなかったのです。

寸法ﾃｰﾌﾞﾙのｻｲｽﾞ変更する方法をmineさんに教えて
頂いたのですが、実際に使う際、一定しない列数を追加し
ﾃｰﾌﾞﾙの見出し?　も入れたいのです。

結構めんどくさいんです。

そこで修正してみました。

'vba DrawTable_Add_LastColumn ver0.0.2  using-'KCL0.0.12'  by Kantoku

Option Explicit

Private Const Def = "hoge,piyo,huga" 'ﾃﾞﾌｫﾙﾄ文字

Sub CATMain()

    'ﾄﾞｷｭﾒﾝﾄのﾁｪｯｸ
    If Not CanExecute("DrawingDocument") Then Exit Sub

    'ﾃｰﾌﾞﾙ選択
    Dim Msg As String
    Msg = "列を追加するﾃｰﾌﾞﾙを選択 // [Esc]=Cancel"
    
    Dim Tbl As DrawingTable
    Set Tbl = KCL.SelectItem(Msg, "DrawingTable")
    If Tbl Is Nothing Then Exit Sub
    
    'ﾕｰｻﾞｰ
    Msg = "追加するﾀｲﾄﾙを入力　例)hoge,piyo""
    Dim Inp As String
    Inp = InputBox(Msg, "", Def)
    If Inp = vbNullString Then Exit Sub
    
    '追加数列
    Dim Txts As Variant: Txts = Split(Inp, ",")
    Dim AddCnt As Long: AddCnt = UBound(Txts) + 1
    
    '元列数
    Dim CntCol As Long: CntCol = Tbl.NumberOfColumns
    Dim AllColCnt As Long: AllColCnt = CntCol + AddCnt
    
    '列追加
    Tbl.ComputeMode = CatTableComputeOFF
    
    Dim i As Long
    For i = 1 To AddCnt
        Call Tbl.AddColumn(CntCol)
    Next
    
    '最後を追加の最初にｺﾋﾟｰ
    Call Copy_Column(AllColCnt, CntCol, Tbl)
    
    '空欄設置
    Call Reset_Column(CntCol + 1, AllColCnt, Tbl)
    
    'ﾀｲﾄﾙ設置
    Call Set_Title(Txts, 25#, Tbl)
    
    Tbl.ComputeMode = CatTableComputeON
End Sub

Private Sub Set_Title(ByVal Ary As Variant, _
                      ByVal Width As Double, _
                      ByVal Tbl As DrawingTable)
    Dim Ed As Long: Ed = Tbl.NumberOfColumns
    Dim St As Long: St = Ed - UBound(Ary)
    
    Dim i As Long, Cell As DrawingText
    Dim Cnt As Long: Cnt = 0
    
    For i = St To Ed
        Call Tbl.SetColumnSize(i, Width)
        Set Cell = Tbl.GetCellObject(1, i)
        Cell.Text = Ary(Cnt)
        Cnt = Cnt + 1
        Cell.TextProperties.Justification = catCenter
    Next
End Sub

Private Sub Reset_Column(ByVal A As Long, _
                         ByVal B As Long, _
                         ByVal Tbl As DrawingTable)

    Dim Vw As DrawingView: Set Vw = Tbl.Parent.Parent
    Dim Dmy As DrawingText: Set Dmy = Vw.Texts.Add("", 0#, 0#)
    Dmy.TextProperties.Justification = catCenter
    
    Dim CntRow As Long: CntRow = Tbl.NumberOfRows
    Dim Cell As DrawingText
    Dim i As Long
    
    For i = 1 To CntRow
        Set Cell = Tbl.GetCellObject(i, B)
        Call Copy_DrwTxtProperties(Cell.TextProperties, _
                                   Dmy.TextProperties)
        Cell.Text = ""
    Next
    
    For i = B To A + 1 Step -1
        Call Copy_Column(i, i - 1, Tbl)
    Next
    
    Dim Sel As Selection
    Set Sel = KCL.GetParent_Of_T(Vw, "DrawingDocument").Selection
    With Sel
        .Clear
        .Add Dmy
        .Delete
    End With
End Sub

Private Sub Copy_Column(ByVal A As Long, _
                        ByVal B As Long, _
                        ByVal Tbl As DrawingTable)
    Dim CntRow As Long: CntRow = Tbl.NumberOfRows
    Dim Cell(1) As DrawingText
    Dim TxtPpt(1) As DrawingTextProperties
    Dim i As Long
    
    For i = 1 To CntRow
        Set Cell(0) = Tbl.GetCellObject(i, A)
        Set Cell(1) = Tbl.GetCellObject(i, B)
        Call Copy_DrwTxtProperties(Cell(0).TextProperties, _
                                   Cell(1).TextProperties)
        Cell(1).Text = Cell(0).Text
    Next
End Sub

Private Sub Copy_DrwTxtProperties(ByVal Tpp1 As DrawingTextProperties, _
                                  ByVal Tpp2 As DrawingTextProperties)
    With Tpp2
        .AnchorPoint = Tpp1.AnchorPoint
        .Blanking = Tpp1.Blanking
        .Bold = Tpp1.Bold
        .Color = Tpp1.Color
        .FONTNAME = Tpp1.FONTNAME
        .FONTSIZE = Tpp1.FONTSIZE
        .FrameName = Tpp1.FrameName
        .FrameType = Tpp1.FrameType
        .Italic = Tpp1.Italic
        .Justification = Tpp1.Justification
        .Kerning = Tpp1.Kerning
        .Mirror = Tpp1.Mirror
        .Overline = Tpp1.Overline
        .StrikeThru = Tpp1.StrikeThru
        .Subscript = Tpp1.Subscript
        .Underline = Tpp1.Underline
    End With
End Sub

見事な肥大化っぷり･･･。
最初の時点ではかなり遅かったのですが、DrawingTable.ComputeModeを
利用するとｽﾄﾚｽを感じるほどでは無くなりました。

ﾏｸﾛ実行後、ﾀﾞｲｱﾛｸﾞが出現しｶﾝﾏ区切りで文字を入力すると
区切った分の列を追加し、見出しとして入力されます。

作ったけど、使うかなぁ･･･。