テキストボックスの大きさを、基準の大きさに戻す（エクセルVBA）

質問

図形のテキストボックスの大きさを取得して、その値を各テキストボックスの基準の大きさとして記録しておき、テキストボックスの大きさをマウスでドラッグして大きさを変えた後、ボタン1つでもとの大きさに戻したいのですが、どのようにすればよいでしょうか？

１）図形のテキストボックス、大きさの取得方法は？
２）基準の大きさと記録する方法は？
３）記録された大きさに戻すには？（シート上に配置されたボタンで実行）

※ 複数のシートに複数のテキストボックスがあります。
※ シート毎にセットします。（シート毎にテキストボックスのサイズが違う為）
※ 現在、各テキストボックスには、基準位置がセットしてあり、ボタンで基準位置へ戻る仕組みが組まれています。（これをそのままにして・・・）

※ エクセル97と2000で使えるようにします。（作成は97）

宜しくお願い致します。

回答No.2

nishi6 · ベストアンサー

前提がクリアされたとして・・・
質問の意味を充分理解したかどうかは疑問ですが・・・・

元のサイズを各シートに入力しておきます。(cm単位)
　　｜□□□□｜　　　Ｎｏ１　　｜　　　Ｎｏ２　　｜　　　Ｎｏ３　　｜
　　｜　高さ　｜　　１．０１　　｜　　１．００　　｜　　１．２０　　｜
　　｜　幅　　｜　　４．００　　｜　　２．５０　　｜　　３．００　　｜
各テキストボックスを右クリックし、オートシェイブの書式設定から基本のサイズを調べます。ダイアログはcm単位ですがＶＢＡでポイントに直します。
上のようにセルに入力して下さい。縦横の表題の交点のセル（□□□□の箇所）に範囲名「SyokiIchi_1」を付けます。「1」はシート番号の意味です。ボタンを押すことでこの値に戻します。シート2なら「SyokiIchi_2」にします。

シート1のコードウインドウに貼り付け(例)
Private Sub CommandButton11_Click() 'サイズを元に戻すボタン
SizeInitialize Val(Right(Me.Name, 1)), tbxClickName
End Sub

標準モジュールに貼り付け
Public Sub SizeInitialize(ShtNo As Integer, txtName As String)
Dim txtHeight As Double '元の高さ
Dim txtWidth As Double '元の幅
Dim TxtNo As Integer 'テキストボックス番号
Dim rg_iniSet As Range '初期位置を書き込んだセル範囲
If Len(txtName) <> 0 Then '選択したテキストボックス名
Set rg_iniSet = Range("SyokiIchi_" & ShtNo)
TxtNo = Val(Right(txtName, 1))
With ActiveSheet.Shapes(txtName)
txtHeight = rg_iniSet.Offset(1, TxtNo) 'cm単位の高さ
txtWidth = rg_iniSet.Offset(2, TxtNo) 'cm単位の幅
.Height = Application.CentimetersToPoints(txtHeight)
.Width = Application.CentimetersToPoints(txtWidth)
.Fill.ForeColor.SchemeColor = 65
End With
End If
End Sub

回答No.1

nishi6

「テキストボックスの大きさを、基準の大きさの戻す（エクセルＶＢＡ）」と
「テキストボックスのフォントサイズの復元」の共通の前提です。

図形のテキストボックスを選択してコマンドボタンを押すと、ボタンを押したことで、どのテキストボックスを選択していたか分からなくなるようです。（手段を尽くせば分かるかもしれないが技術不足で・・・）
どのテキストボックスを選択したか分かるように、テキストボックスをクリックしたら、その名前を覚えるようにしました。
各テキストボックスには「myText1_2」のように名前を付けます。（もう付けている？）「1」はシート番号で、「2」はそのシートでのテキストボックスの番号です。
各シートのコードウインドウにテキストボックスの個数分マクロを作ります(次はシート1に3個の場合)

=== シート1に貼り付け(例) ===
Sub myText1_1_Click() 'Sheet1のテキストボックス1を選択
tbxClickName = "myText1_1": txtSentaku tbxClickName
End Sub
Sub myText1_2_Click() 'Sheet1のテキストボックス2を選択
tbxClickName = "myText1_2": txtSentaku tbxClickName
End Sub
Sub myText1_3_Click() 'Sheet1のテキストボックス3を選択
tbxClickName = "myText1_3": txtSentaku tbxClickName
End Sub

次に各テキストボックスにマクロの登録をします。（選択して右クリック）テキストボックスと対応するものを選びます。

標準モジュールに貼り付け（上の方に）
Public tbxClickName As String '選択したテキストボックス名

標準モジュールに貼り付け
'*** テキストボックスを選択したら色を変える ***
Public Sub txtSentaku(txtName As String)
With ActiveSheet.Shapes(txtName)
.Select
With Selection.ShapeRange.Fill.ForeColor
If .SchemeColor = 65 Then
.SchemeColor = 41
Else
.SchemeColor = 65
End If
End With
.TopLeftCell.Select
End With
End Sub

これで、テキストボックスを選択すると背景色が変わります。再度選択すると戻ります。
このアクションで内部でテキストボックス名を記憶します。

以下次へ・・・・・・

補足

うーーーん！ うまくいきません！なぜでしょう？？？？？
すみません！またお世話になります！

Set rg_iniSet = Range("SyokiIchi_" & ShtNo)
で、エラーです。

シートにサイズを書く位置はどこでもいいんですよねー？？？？？
とりあえず、テストファイルで、Ａ１から書いてますけど・・・・・
範囲名とは、SyokiIchi_1のことですよねー
Ｎｏ１｜ Ｎｏ２ ｜Ｎｏ３｜は大文字？小文字？

宜しくお願いします。