|
ウーム??、善く解らないけどこんな事なのかな?
Function Handan()
With Selection.ShapeRange
myLineName = .Name
'左端を(p,q),右端を(r,s)。右下がりの場合は(p,s),(r,q)となる。
p = .Left
q = .Top + .Height
r = .Left + .Width
s = .Top
End With
aLine = LineNumber & "a"
bLine = LineNumber & "b"
cLine = LineNumber & "c"
'______________________________________________________
If LineNumber = 0 Then '基準線の場合
Select Case Range("B3").Value
Case Is = "上か左"
Handan = "Sitei-Upper"
Case Is = "下か右"
Handan = "Sitei-Down"
End Select
End If
'______________________________________________________
If LineNumber >= 1 Then '三角形が1つ以上作成されている時
With ActiveSheet.Shapes(cLine)
cLeft = .Left
cTop = .Top
cHeight = .Height
cRight = .Left + .Width
cUnder = .Top + .Height
End With
With ActiveSheet.Shapes(aLine)
aLeft = .Left
aTop = .Top
aHeight = .Height
aRight = .Left + .Width
aUnder = .Top + .Height
End With
With ActiveSheet.Shapes(bLine)
bLeft = .Left
bTop = .Top
bHeight = .Height
bRight = .Left + .Width
bUnder = .Top + .Height
End With
'a線が選択された場合
If Right(myLineName, 1) = "a" Then
Handan = LineSelected(q, s, r, cRight, cLeft, _
cTop, cUnder, bRight, bLeft, bTop, bUnder)
'-----------------------------------------------------------
'b線が選択された場合
ElseIf Right(myLineName, 1) = "b" Then
Handan = LineSelected(q, s, r, aRight, aLeft, _
aTop, aUnder, cRight, cLeft, cTop, cUnder)
'c線が選択された場合
ElseIf Right(myLineName, 1) = "c" Then
Handan = LineSelected(q, s, r, bRight, bLeft, _
bTop, bUnder, aRight, aLeft, aTop, aUnder)
End If
End Function
Private Function LineSelected(lngQ As Long, _
lngS As Long, _
lngR As Long, _
Right1 As Long, _
Left1 As Long, _
Top1 As Long, _
Under1 As Long, _
Right2 As Long, _
Left2 As Long, _
Top2 As Long, _
Under2 As Long) As String
If (lngQ = Left1) Or (lngQ = Right1) Then '上に作る
Select Case lngQ
Case Top1, Under1
Select Case lngS
Case Top2, Under2
Select Case lngR
Case Left2, Right2
LineSelected = "MigiAgariUe"
Case Is = Right1
LineSelected = "MigiSagariSita"
Case Else
LineSelected = "MigiAgariUe"
End Select
Case Is = Top1
Select Case lngR
Case Right2
LineSelected = "MigiSagariUe"
Case Else
LineSelected = "MigiAgariUe"
End Select
End Select
Case Top2, Under2
Select Case lngS
Case Top1, Under1
Select Case lngR
Case Left2, Right2
LineSelected = "MigiSagariUe"
Case Else
LineSelected = "MigiAgariSita"
End Select
Case Is = Top2
LineSelected = "MigiSagariUe"
End Select
End Select
ElseIf (lngQ = Left2) Or (lngQ = Right2) Then '下に作る
Select Case lngQ
Case Top2, Under2
Select Case lngS
Case Top1, Under1
Select Case lngR
Case Left1, Right1
LineSelected = "MigiAgariSita"
Case Else
LineSelected = "MigiSagariUe"
End Select
Case Is = Top2
LineSelected = "MigiAgariSita"
End Select
Case Top1, Under1
Select Case lngS
Case Top2, Under2
Select Case lngR
Case Left1, Right1
LineSelected = "MigiSagariSita"
Case Else
LineSelected = "MigiAgariUe"
End Select
Case Is = Top1
LineSelected = "MigiSagariSita"
End Select
End Select
End If
End Function
|
|