Excel VBAでテーブル機能を使用した表の新しい行にチェックボックスを自動入力する
テーブルはすごい便利だけどVBA側はやっかい!
環境 Office365、Office2019、Office2016のExcel
エクセルのテーブル機能はとても便利。
列名で計算指定できるから絶対表記や相対表記を気にしなくてもいいし、
一つに条件付き書式や関数を入れておけば新しいデータにも自動で入力してくれるし、
ページレイアウトの配色やテーマで全て一括であっという間に変更可能 。
ピボットテーブルを作るまでもない表作りには便利なのだが、今回メール配信システムでも作ってみようかと思い、テーブル機能を実装した表に自動でチェックボックスを入れるVBAを組んでいて躓いたので記録を残しておく。
このコードでやりたいこと、できること
VBAでテーブル機能を使用した表に新しい行を追加した時に
・新しい行にチェックボックスを追加
・チェックボックス作成時に名前を消す
・チェックボックス作成時に別のセルにリンクさせTRUE、FALSE表記をさせる
・入力規則を新しい行に受け継ぐ
VBAコード
Sub 新レコード追加()
' 1)挿入したい箇所のセルを選択
Dim LastCell As Long
LastCell = Range("A3").ListObject.ListColumns(1).Range.Count
Range("A3").ListObject.ListColumns(1).Range(LastCell + 1).Select
' 2)アクティブなセルをRange表記に変換
Dim NewCell As Range
Set NewCell = ActiveCell
' 3)アクティブなセルにチェックボックスを入れる
Dim cbx As CheckBox
Set cbx = ActiveSheet.CheckBoxes.Add(NewCell.Left, NewCell.Top, NewCell.Width, NewCell.Height)
' 4)チェックボックスの状態設定
cbx.Caption = ""
cbx.LinkedCell = NewCell.Offset(0, 10).Address
' 5)表の最後にFALSEを入力することでテーブルが自動で延長されるようにする
NewCell.Offset(0, 10).Value = "FALSE"
End Sub
解説
1)挿入したい箇所のセルを選択
Sub 新レコード追加()
' 1)挿入したい箇所のセルを選択
Dim LastCell As Long
LastCell = Range("A3").ListObject.ListColumns(1).Range.Count
Range("A3").ListObject.ListColumns(1).Range(LastCell + 1).Select
' 2)アクティブなセルをRange表記に変換
Dim NewCell As Range
Set NewCell = ActiveCell
' 3)アクティブなセルにチェックボックスを入れる
Dim cbx As CheckBox
Set cbx = ActiveSheet.CheckBoxes.Add(NewCell.Left, NewCell.Top, NewCell.Width, NewCell.Height)
' 4)チェックボックスの状態設定
cbx.Caption = ""
cbx.LinkedCell = NewCell.Offset(0, 10).Address
' 5)表の最後にFALSEを入力することでテーブルが自動で延長されるようにする
NewCell.Offset(0, 10).Value = "FALSE"
End Sub
1)挿入したい箇所のセルを選択
新しい行を入れたいので表の下の左端を選択したい。
ここで注意したいのが普通のセル指定のRangeとテーブルのRangeの指定方法が違うということ。
通常のRangeだとRange("A1")というようにセル指定をするがテーブルの場合はRange("A1").ListObject.ListColumns(1)となる。
分解すると、
Range("A1")・・・テーブルの始まる位置
.ListObject.ListColumns(1)・・・スタートから何個目のセルか
イメージとしては
A1(1) | B1(2) | C1(3) | D1(4) |
---|---|---|---|
A2(5) | B2(6) | C2(7) | D2(8) |
A3(9) | B3(10) | C3(11) | D3(12) |
これを踏まえて1)の解説をすると
・LastCellを宣言する
・LastCellはA3から始まるテーブルに含まれるセル数をカウントした最後の場所
・最後のセル+1(新しく入力したいセル)を選択する
' 1)挿入したい箇所のセルを選択
Dim LastCell As Long
LastCell = Range("A3").ListObject.ListColumns(1).Range.Count
Range("A3").ListObject.ListColumns(1).Range(LastCell + 1).Select
2)アクティブなセルをRange表記に変換
・NewCellを宣言する
・今選択しているセルをNewCellとする
これで一旦通常のRange表記に戻しておく。これをRangeに戻しておかないと次のチェックボックスがうまくいい場所に収まらない。
' 2)アクティブなセルをRange表記に変換
Dim NewCell As Range
Set NewCell = ActiveCell
気付くのに数時間かかって四苦八苦した。
同じRangeなんて名前つけないでほしい。
3)アクティブなセルにチェックボックスを入れる
・cbxという名前でチェックボックスを宣言する
・現在のシートの2)で設定したNewCellの場所にNewCellと同じ大きさでチェックボックスを入れる
ChechBoxes.Add(Left, Top, Width, Height)で挿入できるのでセルがあらかじめ決まっている場合は
ChechBoxes.Add(Range("A1").Left, Range("A1").Top, Range("A1").Width, Range("A1").Height)
というように入れることもできる。
' 3)アクティブなセルにチェックボックスを入れる
Dim cbx As CheckBox
Set cbx = ActiveSheet.CheckBoxes.Add(NewCell.Left, NewCell.Top, NewCell.Width, NewCell.Height)
4)チェックボックスの状態設定
・何も設定しないとチェックボックス1という名前が入るので空白を指定
・NewCellから右に10個離れた場所のセルをcbxのリンク先とする
チェックボックスに他に指定したいものがある場合cbx.まで打つと候補が出てくるのでその中から選ぶとよい。
' 4)チェックボックスの状態設定
cbx.Caption = ""
cbx.LinkedCell = NewCell.Offset(0, 10).Address
5)表の最後にFALSEを入力することでテーブルが自動で延長されるようにする
・テーブル機能を自動で適応するために、あらかじめ入る文字が決まっているセルにFALSEという文字(値)を入力
チェックボックスにcbx.Value = Falseといれてみたがチェックボックスの状態はFALSEになってもリンク先のセル内に「FALSE」が出なかったため、テーブル機能が適応されなかった。
cbx.Value = Trueとした場合は自動でテーブル機能が適応されリンク先のセルに「TRUE」と入力された。
どうやら初期設定がFalseの場合、リンク先のセルの初期値はnullのままで何も入力されないようだ。
SendKeys "{F2}"で入力状態にすることでテーブルの延長もできそうなのだがそうするとVBA終了後Enterを押す必要が出てくるのでこの方法は使いたく無かった。
今回は自動でテーブルを延長したかったのと初期状態はチェック無しにしたかったので文字の入力を行うことで解決した。
テーブル機能を持ったまま表に行が追加されると自動で入力規則や関数は入るようになっている。
' 5)表の最後にFALSEを入力することでテーブルが自動で延長されるようにする
NewCell.Offset(0, 10).Value = "FALSE"
Author And Source
この問題について(Excel VBAでテーブル機能を使用した表の新しい行にチェックボックスを自動入力する), 我々は、より多くの情報をここで見つけました https://qiita.com/nobody_gonbe/items/7784840469cddb562637著者帰属:元の著者の情報は、元のURLに含まれています。著作権は原作者に属する。
Content is automatically searched and collected through network algorithms . If there is a violation . Please contact us . We will adjust (correct author information ,or delete content ) as soon as possible .