|
ちょっと分割して、任意選択実行もできるようにしてみました。
'全てシートモジュール
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
|
|