こんにちは、Dancing Shigekoです！
昨日に続き、エクセルでのスケジュール表づくり。→前回
二行目以降の入力が同一テキストボックスに入ってしまう。
これを解消するのに、いろいろと試すものの、なかなかうまくいかない。
少し方針を変更して、二行目に入れても文字が出力される方法がないか試してみることに。
---
Private Sub Worksheet_Change(ByVal Target As Range)
Dim txt As String
Dim tb As Shape
Dim tempShape As Shape
Dim tempWidth As Double
Dim tempHeight As Double
Dim padding As Double
Dim cell As Range
Dim tbName As String
' パディングを設定
padding = 10
' A1, A2の変更を監視
If Not Intersect(Target, Me.Range("A1:A2")) Is Nothing Then
For Each cell In Target
If cell.row = 1 Or cell.row = 2 Then
' テキストボックスの名前を設定
tbName = "MyTextBox" & cell.row
' テキストボックスが存在するか確認
On Error Resume Next
Set tb = Me.Shapes(tbName)
On Error GoTo 0
' テキストボックスが存在しない場合は作成
If tb Is Nothing Then
Set tb = Me.Shapes.AddTextbox(msoTextOrientationHorizontal, 100, 100 + (cell.row - 1) * 100, 200, 50)
tb.Name = tbName
End If
' セルの内容を取得してテキストボックスに設定
txt = cell.Value
tb.TextFrame.Characters.text = txt
' 一時的なテキストボックスを作成してサイズを計算
Set tempShape = Me.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 0, 0)
tempShape.TextFrame.Characters.text = txt
tempShape.TextFrame.AutoSize = True
tempWidth = tempShape.Width
tempHeight = tempShape.Height
tempShape.Delete
' テキストボックスのサイズを設定
tb.Width = tempWidth + padding
tb.Height = tempHeight + padding
End If
Next cell
End If
End Sub
---
A列だけを対象にしたら、一応出せるようになった。
これであとはセルをB列、C列の入力も反映できるようにしたらいいはず！
明日には次のステップに行けるようになるか。
乞うご期待！
Comments