| 
    
     |  | ウーム??、善く解らないけどこんな事なのかな? 
 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
 
 |  |