テキストボックスをグループ化するＶＢＡ

質問

エクセル上に並んだテキストボックスを、ボタンを押すことで、任意のテキストボックスをグループ化させたい。また、別のボタンでグループ化の解除が出来るようなＶＢＡをおしえてください。

テキストボックスは、Sheet１～３まであって、ボタンもそれぞれに配置してあり、
どこのSheetのボタンを押しても、各シート、それぞれに任意の設定したテキストボックスがグループ化できるようにしたい
※各シート、グループ化するテキストボックスはおなじでなない・・・

よろしくお願いします。

回答No.2

nishi6 · ベストアンサー

「任意」の意味はVBAの中で自由に設定できると解釈しました。Case以下を参考にして下さい。
下の例は、Sheet1～3の各テキストボックスに、'各シートに対応してmyText1_1、myText1_2、myText1_3・・・と名前を付けています。（Textの次がシート番号です）
２つのボタンは逆の処理なので表示・非表示を切り替えています。
最初は、結合していない状態を確かめて、結合ボタンから開始して下さい。

'標準モジュールに貼り付けます。
Public Sub Ketugou(mySht As Integer)
Dim sht As Integer 'シート
Application.ScreenUpdating = False
For sht = 1 To 3
Worksheets("Sheet" & sht).Activate
With Worksheets("Sheet" & sht)
Select Case sht
Case 1 '例、1,2,3を結合
.Shapes.Range(Array("myText1_1", "myText1_2", "myText1_3")).Select
Case 2 '例、2,3,4を結合
.Shapes.Range(Array("myText2_2", "myText2_3", "myText2_4")).Select
Case 3 '例、1,4を結合
.Shapes.Range(Array("myText3_1", "myText3_4")).Select
End Select
Selection.ShapeRange.Group.Select 'グループ化
Selection.Name = "grp" & sht 'グループ名(解除できるよう勝手に名前を付けている)
.Shapes("grp" & sht).TopLeftCell.Select 'グループの左上を選択状態にする
.cmdKetugo.Visible = False '結合ボタンを非表示
.cmdKaijyo.Visible = True '解除ボタンを表示
End With
Next
Worksheets("Sheet" & mySht).Select '元のシートに戻る
Application.ScreenUpdating = True
End Sub

Public Sub Kaijyo(mySht As Integer)
Dim sht As Integer 'シート
Application.ScreenUpdating = False
For sht = 1 To 3
Worksheets("Sheet" & sht).Activate
With Worksheets("Sheet" & sht)
.Shapes("grp" & sht).Select 'グループを選択
Selection.ShapeRange.Ungroup.Select '結合解除
.Shapes("myText" & sht & "_1").TopLeftCell.Select '左上セル
.cmdKetugo.Visible = True '結合ボタンを表示
.cmdKaijyo.Visible = False '解除ボタンを非表示
End With
Next
Worksheets("Sheet" & mySht).Select '元のシートに戻る
Application.ScreenUpdating = True
End Sub

各シートには同名のボタンが２個あります。cmdKetugoとcmdKaijyo。
各シートモジュールに貼り付けます。ただし、KetugouとKaijyoの次の数値は、そのシート番号にします。どのシートに復帰すればいいかを表しています。
Private Sub cmdKetugo_Click()
Ketugou 1
End Sub

Private Sub cmdKaijyo_Click()
Kaijyo 1
End Sub

お礼

またまたnishi6さん！いつもすみません！ありがとうございます。
結合したら結合ボタンが消えて、解除が現れの繰り返し、には感動しました。
おーっ！って感じでした。今回も一発で成功しました。
ほんとにいつもいつもありがとうございます。

ところで、さいそくしてすみませんが、テキストボックスに値を入れるの質問１）２）３）の件、私のほうは、まだうまくいきません！やっぱりまだまだですね！もう、私の作戦はでつくしました。ギブアップ寸前です。いつも無理言ってすみませんが、よろしくお願いします。

回答No.1

ARC

Private Sub CommandButton1_Click()
　'グループ化
　Dim myDocument As Worksheet
　Set myDocument = Worksheets("Sheet1")
　myDocument.Shapes.Range(Array("Text Box 1", "Text Box 3")).Group
End Sub

Private Sub CommandButton2_Click()
　'グループ解除
　Dim myDocument As Worksheet
　Set myDocument = Worksheets("Sheet1")
　myDocument.Shapes("Group 1").Ungroup
End Sub

ヘルプ「ShapeRange コレクション オブジェクト」のサンプルの変形です。
"Text Box 1"などの名前に関しては、あらかじめイミディエイトペインで
? Worksheets(1).shapes(1).name
などとして調べておけば良いでしょう。

グループ解除については、ここでは単純化していますが実際には、も少しややこしいです。
というのも、グループ化を行うごとにShapeオブジェクトが新規に生成され、同時に名前(Group X)が新しく自動で生成されるからです。

この問題に関しては、グループ化を行う前と後で、Shapesコレクションの中身を比較し、新たに増えたオブジェクトの名前を記録しておけば解決できると思います。

不明点とかあれば、補足してください。

お礼

ＡＲＣさん！いつも回答ありがとうございます。
早速コードを書いていますが、まだ動いてくれません。でも何とか動きそうなのでがんばってみます。
また何かありましたら、よろしくお願いします。ありがとうございました。