ものづくり：スケジュール表、第二ステップ テキストボックスのサイズを自動調整

　こんにちは、Dancing Shigekoです！

　今日はテキストボックスのサイズを自動調整するように挑戦。

　ChatGPTに相談をして次のプログラムが提案される。

---

Private Sub Worksheet_Change(ByVal Target As Range)

Dim txt As String

Dim tb As Shape

Dim maxWidth As Double

Dim totalHeight As Double

Dim padding As Double

Dim cell As Range

Dim tempShape As Shape

Dim tempWidth As Double

Dim tempHeight As Double

' A1, B1, C1の変更を監視

If Not Intersect(Target, Me.Range("A1:C1")) Is Nothing Then

' テキストボックスが存在するか確認

On Error Resume Next

Set tb = Me.Shapes("MyTextBox")

On Error GoTo 0

' テキストボックスが存在しない場合は作成

If tb Is Nothing Then

Set tb = Me.Shapes.AddTextbox(msoTextOrientationHorizontal, 100, 100, 200, 50)

tb.Name = "MyTextBox"

End If

' A1, B1, C1の内容を取得してテキストボックスに設定

txt = Me.Range("A1").Value & vbCrLf & Me.Range("B1").Value & vbCrLf & Me.Range("C1").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

' パディングを追加

padding = 10

' テキストボックスのサイズを設定

tb.Width = tempWidth + padding

tb.Height = tempHeight + padding

End If

End Sub

---

早速実行してみると、セルに入力したフォントに合わせて、テキストボックスのサイズが自動で調整されるようになった！

　次は二行目以降でも同じ処理ができるようにしていきたい！

　乞うご期待！