|
▼Ned さん:
またまた
ありがとうございました。
goodです(^_^)/~
ちなみに罫線が多少斜めに引いた場合まっすぐに修正は
できませんか【50409】作品では出来ているようなのですが・・・
>ちょっと分割して、任意選択実行もできるようにしてみました。
>
>'全てシートモジュール
>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
|
|