| |
有難うございます。
こんな長いものを載せてご迷惑かと思いますが怒らないで下さい。
3本のオートシェープの直線で作成された三角形がどのような形で作られているかを調べてその反対側に新しい三角形を作る際の判断に使用しています。
選択されている線がa線、ｂ線、ｃ線の場合分けが必要ですが変数を入れ替えるだけで 43行目から下のIf分岐は1回ですむのではないかと思いました。
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")
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
If (p = cLeft) Or (p = cRight) Then '上に作る
Select Case q
Case cTop, cUnder
Select Case s
Case bTop, bUnder
Select Case r
Case bLeft, bRight
Handan = "MigiAgariUe"
Case Is = cRight
Handan = "MigiSagariSita"
Case Else
Handan = "MigiAgariUe"
End Select
Case Is = cTop
Select Case r
Case bRight
Handan = "MigiSagariUe"
Case Else
Handan = "MigiAgariUe"
End Select
End Select
Case bTop, bUnder
Select Case s
Case cTop, cUnder
Select Case r
Case bLeft, bRight
Handan = "MigiSagariUe"
Case Else
Handan = "MigiAgariSita"
End Select
Case Is = bTop
Handan = "MigiSagariUe"
End Select
End Select
ElseIf (p = bLeft) Or (p = bRight) Then '下に作る
Select Case q
Case bTop, bUnder
Select Case s
Case cTop, cUnder
Select Case r
Case cLeft, cRight
Handan = "MigiAgariSita"
Case Else
Handan = "MigiSagaiUe"
End Select
Case Is = bTop
Handan = "MigiAgariSita"
End Select
Case cTop, cUnder
Select Case s
Case bTop, bUnder
Select Case r
Case cLeft, cRight
Handan = "MigiSagariSita"
Case Else
Handan = "MigiAgariUe"
End Select
Case Is = cTop
Handan = "MigiSagariSita"
End Select
End Select
End If
'-----------------------------------------------------------
'ここから下を省略したいです
'ｂ線が選択された場合
ElseIf Right(myLineName, 1) = "b" Then
If (p = aLeft) Or (p = aRight) Then '上に作る
Select Case q
Case aTop, aUnder
Select Case s
Case cTop, cUnder
Select Case r
Case cLeft, cRight
Handan = "MigiAgariUe"
Case Is = aRight
Handan = "MigiSagariSita"
Case Else
Handan = "MigiAgariUe"
End Select
Case Is = aTop
Select Case r
Case cRight
Handan = "MigiSagariUe"
Case Else
Handan = "MigiAgariUe"
End Select
End Select
Case cTop, cUnder
Select Case s
Case aTop, aUnder
Select Case r
Case cLeft, cRight
Handan = "MigiSagariUe"
Case Else
Handan = "MigiAgariSita"
End Select
Case Is = cTop
Handan = "MigiSagariUe"
End Select
End Select
ElseIf (p = cLeft) Or (p = cRight) Then '下に作る
Select Case q
Case cTop, cUnder
Select Case s
Case aTop, aUnder
Select Case r
Case aLeft, aRight
Handan = "MigiAgariSita"
Case Else
Handan = "MigiSagariUe"
End Select
Case Is = cTop
Handan = "MigiSagariSita"
End Select
Case aTop, aUnder
Select Case s
Case cTop, cUnder
Select Case r
Case aLeft, aRight
Handan = "MigiSagariSita"
Case Else
Handan = "MigiAgariUe"
End Select
Case Is = aTop
Handan = "MigiSagariSita"
End Select
End Select
End If
'ｃ線が選択された場合
ElseIf Right(myLineName, 1) = "c" Then
'
以下略
'10000文字を超えるためエラーで送信できません
End Function
|
|
yata
- 06/10/28(土) 22:08 -
