エクセルのマクロについて

質問

エクセル2010を使用しています。
工程表を作成するため、以下のマクロを組もうと苦戦しています。

任意のセルを選択し、マクロを実行すると選択したセルに線を引き
線の上部にテキストボックスで文字を入力できるようにするマクロを
作成しようとしています。

また、テキストボックスは文字入力後、大きさの自動調整をかけようと
しています。
線を引くところまでは、うまくいったのですがテキストボックスの挿入→入力待機
→入力後、大きさの自動調整（幅）までのマクロがよくわかりません。
可能であれば、任意の選択したセルの中央に配置をしたいです。
お知恵をお貸しください。よろしくお願いします。

koutei()

Dim SentakuTop As Single
Dim SentakuLeft As Single
Dim SentakuWidth As Single
Dim SentakuHeight As Single
Dim SentakuAddress As String
Dim X0, Y0, X1, Y1 As Variant

SentakuAddress = Selection.Address(ColumnAbsolute:=False, RowAbsolute:=False)

With ActiveSheet.Range(SentakuAddress)
SentakuTop = .Top
SentakuLeft = .Left
SentakuWidth = .Width
SentakuHeight = .Height
End With

X0 = SentakuLeft
Y0 = SentakuTop + SentakuHeight / 2
X1 = SentakuLeft + SentakuWidth
Y1 = Y0

With ActiveSheet.Shapes.AddLine(X0, Y0, X1, Y1).Line
.ForeColor.RGB = RGB(0, 0, 0)
.Weight = 1
.BeginArrowheadStyle = msoArrowheadOval
.EndArrowheadStyle = msoArrowheadOval
End With

End Sub

回答No.2

keithin · ベストアンサー

よく検討してみると、テキストボックスの幅が選択セル幅より広くても狭くても同じマクロになります。

sub kouteir1()

Dim SentakuTop As Single
Dim SentakuLeft As Single
Dim SentakuWidth As Single
Dim SentakuHeight As Single
Dim SentakuAddress As String
Dim X0, Y0, X1, Y1 As Variant
　dim s1 as shape
　dim s2 as shape
　dim txt as string

SentakuAddress = Selection.Address(ColumnAbsolute:=False, RowAbsolute:=False)

With ActiveSheet.Range(SentakuAddress)
SentakuTop = .Top
SentakuLeft = .Left
SentakuWidth = .Width
SentakuHeight = .Height
End With

X0 = SentakuLeft
Y0 = SentakuTop + SentakuHeight / 2
X1 = SentakuLeft + SentakuWidth
Y1 = Y0

　set s1 = ActiveSheet.Shapes.AddLine(X0, Y0, X1, Y1)
　With s1.Line
　　.ForeColor.RGB = RGB(0, 0, 0)
　　.Weight = 1
　　.BeginArrowheadStyle = msoArrowheadOval
　　.EndArrowheadStyle = msoArrowheadOval
　End With

　txt = inputbox("TEXT")
　if txt = "" then exit sub
　set s2 = activesheet.shapes.addtextbox(msotextorientationhorizontal, x0,y0,x1 - x0,y1 - y0)
　with s2.textframe
　　.characters.text = txt
　　.horizontalalignment = xlcenter
　　.verticalalignment = xlcenter
　　.autosize = true
　end with

　s2.top = s1.top - s2.height
　s2.left = s1.left - (s2.width - s1.width) / 2

End Sub

お礼

回答が遅くなりすみません。
ばっちりです。
ありがとうございました。

回答No.1

tsubuyuki

せっかくココまで出来たのですから、もう一歩、考えてみませんか？
というわけで、とりあえずヒントです。

まず、「テキストボックスの挿入～テキストボックスの大きさの調整」は
マクロの記録機能で録れますね。
テキストボックス内での横方向の中央揃えも忘れずに。

それをちょこっと手直ししてやりましょう。
基本的には直線と同じ感覚でできますから、
記録されたモノを見ればきっとわかります。

で、問題は「位置の調整」ですね。

テキストボックスよりも該当セルの方が大きいと仮定して・・
例えば、「セルの横幅からテキストボックスの横幅を引く」とどうなるでしょう？
「セル内における幅（横＝左右）方向の余白の“合計”」を求められますね。
と言うことは、これを「２で割る」と、「左余白」だけを求められます。
現状のコードで「SentakuWidth = .Width」を使って「セルの幅」は取れていますね。
と言うことは、あとは「テキストボックスの幅」を取ってやれば計算が出来そうです。
最終的に、「セルの左端の座標＋セル内での左余白」を計算してやれば、
「テキストボックスの左端の座標」も求められるわけですね。
位置の調整自体は「直線の位置指定」と同様です。

上下余白についても同様に計算・設定できます。

頑張ってみるか、優しい回答者さまを待つか、判断はお任せします（笑）。

お礼

回答が遅くなりすみません。
ヒントありがとうございます。
頭の考え方をもう少し柔らかくしてみます。
ありがとうございます。