「今さら」なんてない

「自分にもできそう」を伝播させるブログ

自作タスク管理ツール拡張機能:テンプレート挿入

こちらの記事で紹介したExcelタスク管理ツールの補助機能の紹介です。
はじめての方はまずはこちらの記事をどうぞ。 yoshino-ya.hatenablog.com



それでは本題です。

よく使う手順やフレームワークについては、毎度入力したり、どこかにテンプレートを置いておいていちいち参照→コピペって面倒くさいですよね。
なので作りました!(ようやく)

f:id:yoshino-ya:20180713043207p:plain

やること

今回もコードの貼り付け以外に少しお手間を取らせます

  1. ユーザーフォームを用意する

  2. ”テンプレート”シートを用意する

  3. コードのコピペ(ユーザーフォーム)

  4. コードのコピペ(標準モジュール)

  5. ショートカットの割当「フィルタリング」

ユーザーフォームを用意する

挿入したユーザーフォームの各オブジェクト名をCaptionから下記のように編集して下さい

オブジェクト名 Caption
Userform Userform2テンプレート
Listbox ListBox_テンプレート選択覧
CommandButton CommandButton_テンプレート挿入実行



ユーザーフォームの挿入・編集方法はこちらに図解がありますのでこちらもあわせて御覧ください。

yoshino-ya.hatenablog.com

【注】フィルタリングの際との違い
ListBoxのプロパティの下の方のMultiSelectについては、今回は0-fmMultiSeletSingleのままににして下さい

”テンプレート”シートのA~D列に下図の様な表を用意します

f:id:yoshino-ya:20180713043158p:plain ※A列は必ずセルを結合して下さい
結合した行の範囲でテンプレートを区切っています。



お疲れ様でした。ここからはコピペだけです。

ユーザーフォームのコードをコピペ

Userform2テンプレートを右クリック→コードの表示

下記コードをコピペ

Dim lastRow As Long
Dim RowNum, TempNum
Dim myData()
Const テンプレート数 = 50

Private Sub UserForm_Initialize()
'    ListBox_テンプレート選択覧.ListIndex(1) = True
    
    With Worksheets("テンプレート")
        lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
    End With
    
    TepmNum = 0
    With Worksheets("テンプレート")
        For RowNum = 1 To lastRow
            If .Cells(RowNum, 1).Value <> "" Then
                ReDim Preserve myData(テンプレート数, 2)
                myData(TempNum, 0) = TempNum + 1
                myData(TempNum, 1) = .Cells(RowNum, 2).Value
                myData(TempNum, 2) = RowNum
                TempNum = TempNum + 1
            End If
        Next RowNum
    End With
    
    'リストをシート(テンプレート)から取得する
        Load UserForm2テンプレート
        With UserForm2テンプレート.ListBox_テンプレート選択覧
            .ColumnCount = 3
            .ColumnWidths = "15;50;0"
            .List = myData
        End With
End Sub

Private Sub ListBox_テンプレート選択覧_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call CommandButton_テンプレート挿入実行_Click
End Sub

Private Sub CommandButton_テンプレート挿入実行_Click()
    For i = 0 To ListBox_テンプレート選択覧.ListCount - 1
        If ListBox_テンプレート選択覧.Selected(i) = True Then
            Debug.Print myData(i, 2)
            Call テンプレート転記(myData(i, 2))
        End If
    Next i
    
    Unload Me

End Sub

Sub テンプレート転記(Temp_startRow)
    Dim 詳細No, テンプレートの締める行数
    Dim Temp_end
    
    With Sheets("テンプレート")
        '呼び出したテンプレートに必要な行数分の行を挿入する
            テンプレートの締める行数 = .Cells(Temp_startRow, 1).MergeArea.Count
            Temp_end = テンプレートの締める行数 + .Cells(Temp_startRow, 1).Row - 1
            Rows(ActiveCell.Row & ":" & Temp_end + ActiveCell.Row).Insert Shift:=xlDown
        
        '呼び出したテンプレートを転記する
            .Range(.Cells(Temp_startRow, 3), .Cells(Temp_startRow + テンプレートの締める行数 - 1, 4)) _
                .Copy Destination:= _
                Cells(ActiveCell.Row, 2).Resize(テンプレートの締める行数 - 1, 2)
    End With
    
End Sub

標準モジュールを挿入し、下記コードをコピペする

Option Explicit

Sub テンプレート選択挿入()
    UserForm2テンプレート.Show
End Sub

ショートカットの割当「テンプレート選択挿入」

”設定”シートのショートカット割当をします。僕はいったんCtrl+Tにしています

ショートカット割当方法はこちらをどうぞ

yoshino-ya.hatenablog.com



以上です。

残課題:動的配列がわからない、、、

Redimで要素数を変えられるっぽいのですがうまくできません、、、
今回はテンプレートだから50個もあれば十分と考え、静的配列にしていますが、足りないよって方はConst テンプレート数 = 50という部分を任意の数に変更して下さい。