VBAでテキストボックスを作成

質問

エクセルのVBAで、セルに長めの文章を打ち込む時、セルを選択したらテキストボックスなりが開くようなことはできませんか？
テキストボックスは別窓じゃなく、同じエクセル内で開くのが望ましいです。

回答No.1

cj_mover · ベストアンサー

こんにちは。

２段階で作業してください。

まずは、以下（Sub 準備）をシートモジュールに貼り付けて
一度だけ実行し、
新規のテキストボックスを追加します。
テキストボックスは非表示になりますから、
実行結果を視認することはできません。
（見た目上、何も変わりません）
処理が終わったら「Sub 準備」は削除してください。

' ' ＝＝＝＝＝＝＝＝＝＝＝＝シートモジュール＝＝＝＝＝＝＝＝＝＝＝＝
Sub 準備()　　' 8309423
　　With Me.OLEObjects.Add(ClassType:="Forms.TextBox.1", _
　　　　　　　　　　　　　　Left:=0, Top:=0, _
　　　　　　　　　　　　　　Width:=300, Height:=50)　　'　　←お好みで
　　　　With .Object
　　　　　　.MultiLine = True
　　　　　　.WordWrap = True
　　　　　　.IntegralHeight = True
　　　　　　.BackColor = &HAAFFFF　　'　　←お好みで
　　　　　　.Font.Size = 14　　'　　←お好みで
　　　　End With
　　　　.Name = "TB1"
　　　　.Visible = False
　　End With
End Sub
' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

次に、以下２つのプロシージャをシートモジュールに貼り付けてください。
（必ず「Sub 準備」の実行、削除が済んでから貼付け）

' ' ＝＝＝＝＝＝＝＝＝＝＝＝シートモジュール＝＝＝＝＝＝＝＝＝＝＝＝
Option Explicit
Private rLink As Range
Private flgCtrl As Boolean
' '　ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
' ' ダブルクリックイベントでテキストボックスを表示、編集状態にする
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
　　　　　　　　　　　　　　　　　　　　Cancel As Boolean)　　' 8309423
　　' ' テキストボックスを表示させたい範囲（仮にA1:B20）を
　　' ' 必要に合わせて要指定。　　↓
　　If Intersect(Target, Range("A1:B20")) Is Nothing Then Exit Sub
　　Cancel = True
　　With TB1
　　　　Set rLink = Target(1)
　　　　.Left = Target.Left + Target(1).Width / 2
　　　　.Top = Target.Top + Target(1).Height / 2
　　　　.Value = Target(1).Value
　　　　.Visible = True
　　　　.Activate
　　End With
End Sub
' '　ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
' ' テキストボックス確定時（Enter）セルに値を設定
' ' 改行（Ctrl+Enter）は改行として確定時（Enterとは区別する
' ' Escキーならキャンセル（テキストボックス非表示）
Private Sub TB1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, _
　　　　　　　　　　　　ByVal Shift As Integer)　　' 8309423
　　Select Case KeyCode
　　Case vbKeyReturn
　　　　If Not flgCtrl Then
　　　　　　TB1.Visible = False
　　　　　　rLink.Value = TB1.Value
　　　　　　rLink.Activate
　　　　　　Set rLink = Nothing
　　　　End If
　　Case vbKeyEscape
　　　　TB1.Visible = False
　　　　rLink.Activate
　　　　Set rLink = Nothing
　　End Select
　　flgCtrl = KeyCode = vbKeyControl
End Sub
' '　ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
' ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

以上で設定完了です。

セルをダブルクリックすれば、入力用のテキストボックスが表示されます。
> セルを選択したらテキストボックスなりが開くようなことはできませんか？
Excel VBAには、
”セルを選択したら”（≒”セルをクリックしたら”）というタイミングを
正しく表現できるイベントが用意されていません。
ここでは_BeforeDoubleClick イベントを利用していますが、
_BeforeRightClick イベントの方が好ましいようでしたら、
そのままプロシージャ名のDoubleをRightに書き換えることで
対応できるように書いてあります。
テキストボックスを表示させる契機にするセル範囲を指定してください。
例として仮に、Range("A1:B20")としていますので、
運用に合わせて適宜Rangeを指定してください。
もしも、すべてのセルに対して、ということでしたら、
　　If Intersect(Target, Range("A1:B20")) Is Nothing Then Exit Sub
の行は削除してください。
テキストボックスの表示上のプロパティ等はお好みで調整してください。

テキストボックス編集状態から、
Enterキーで確定、
Escキーでキャンセル、
という使い方です。
改行（Ctrl+Enter）可能です。
Ctrlキーを空打ちしてしまった場合は、続けてEnterしても確定しません。
（再度Enterすれば確定します。）
テキストボックス表示後にセル選択を移動しても、
テキストボックス表示時の選択セルに値を返します。
テキストボックス表示時の左上にあるセルが出力先です。

> テキストボックスは別窓じゃなく、同じエクセル内で開くのが望ましいです。
”同じエクセル内”ということなので、
ActiveXコントロールのテキストボックスをシート上に配置するようにしましたが、
ユーザーフォームを使ってもいいなら、その方が扱い易いとは思います。

以上です。

回答No.2

googoo900

セルを選択した時点では、打ち込む文章が長いのか短いのか判断できません。その時点で、テキストボックスが開くのは、少し無理があるかと思いました。
（テキストボックスを開きたくないときでも開いてしまうので、作業の邪魔になると判断しました）

なので、セルに文章を入力した後で、選択したセルの内容をテキストボックスに転記するマクロを作りました。
セルの複数選択にも対応していますので、手間はかからないと思います。

Sub textcopy()
Dim cl As Range

For Each cl In Selection.Cells ' 選択セルの横にテキストボックスを作成する
ActiveSheet.Shapes.AddTextbox( _
Orientation:=msoTextOrientationHorizontal, _
Left:=cl.Offset(0, 1).Left, _
Top:=cl.Offset(0, 1).Top, _
Width:=cl.Offset(0, 1).Width, _
Height:=cl.Offset(, 1).Height).Select

With Selection
.Characters.Text = cl.FormulaLocal ' テキストに転記
.AutoSize = True ' 自動サイズ調整
End With
cl.Select ' テキストボックス選択解除
Next cl
End Sub