| 
    
     |  | ちょっと分割して、任意選択実行もできるようにしてみました。 
 '全てシートモジュール
 Option Explicit
 Dim flg As Boolean
 
 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 Cancel = True
 CommandBars.FindControl(ID:=130).Execute
 flg = True
 End Sub
 
 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 If flg Then
 Call LINETXT(Me.Lines(Me.Lines.Count))
 flg = False
 End If
 End Sub
 
 Private Sub LINETXT(ByRef LX As Line)
 Const x As Single = 1!
 Dim Lp As Single
 Dim Tp As Single
 Dim Wp As Single
 Dim Hp As Single
 Dim St As String
 
 With LX
 Lp = .Left
 Tp = .Top
 Wp = .Width
 Hp = .Height
 End With
 If Wp > Hp Then
 St = "W " & Wp * x
 Else
 St = "H " & Hp * x
 End If
 With Me.TextBoxes.Add(0, 0, 0, 0)
 .ShapeRange.Line.Visible = msoFalse
 .HorizontalAlignment = xlCenter
 .VerticalAlignment = xlCenter
 .AutoSize = True
 .Font.Size = 9
 .Text = St
 .Left = Lp + (Wp - .Width) / 2
 .Top = Tp + (Hp - .Height) / 2
 .Select
 End With
 'CommandBars.FindControl(ID:=1401).Execute '必要なら
 End Sub
 
 Sub sampletest()
 If TypeName(Selection) = "Line" Then
 Call LINETXT(Selection)
 End If
 End Sub
 
 
 |  |