第69回目 図形編(その7) 直線を引く、線の太さ･矢印

○第69回目　図形編(その7)　直線を引く、線の太さ･矢印
　※マクロはエクセル2007でのものです。2003でも動きました。

　4.直線を引く(水平、垂直線)
　この機能は、図形の一括作成(第64回)の機能の中に、図形の種類の追加として付加します。
　1.入力画面表示へ追加
　2セレクト文の追加
　対応は、次のようになります。

　1.
　　z_form = InputBox("図計の種類を入れてください。" & vbCrLf & _
　　"１=⇒面とり長方形" & vbCrLf & _
　　"２=⇒楕円" & vbCrLf & _
　　"３=⇒爆発" & vbCrLf & _
　　"４=⇒吹き出し" & vbCrLf & _
　　"５=⇒直線(水平)" & vbCrLf & _
　　"６=⇒直線(垂直)" & vbCrLf & _
　　"　　" & vbCrLf _
　　, xpos:=2000, ypos:=3000, Default:=1)

　2.
　Case "5"　　'直線(水平)
　　ActiveSheet.Shapes.AddLine(80.25, 840#, 309#, 840#).Select
　Case "6"　　'直線(垂直)
　　ActiveSheet.Shapes.AddLine(82.5, 875.25, 82.5, 972#).Select

　というような追加をしておけば、対応終了です。
　ついでに、右向きの矢印の図形の必要な文も追加しておきます。

　 "７=⇒大きな矢印；右向き" & vbCrLf & _

　Case "7"
　　 ActiveSheet.Shapes.AddShape(msoShapeRightArrow, 231.75, 178.5, 73.5, 59.25).Select

　おしまい。

　5.線、コネクタの線の太さ、矢印の向きの修正

　この処理は、図形の範囲を指定します。その中でライン関係のものだけ処理します。
　1.対象とする図形の範囲を入力する
　2.太さか矢印かの区分を入力する
　3-1.太さの場合、線の幅を入力する。
　3-2.矢印の場合、矢印の向き(なし、右向き、左向き、両方に矢印)を入力する。
　4-1.太さの変更
　4-2.矢印の向きの変更

　1.は省略。

　2.は
　　kubun = InputBox("処理区分を入れてください。" & vbCrLf & _
　　"１=⇒太さの指定" & vbCrLf & _
　　"２=⇒矢印の指定" & vbCrLf & _
　　"　　" & vbCrLf _
　　, xpos:=2000, ypos:=3000, Default:=1)

　　※図形の数はどこかの段階で求めておいてください。
　　ii9 = ActiveSheet.Shapes.Count
　　同時に、図形の名前を取得します
　　For i = 1 To ii9
　　 ActiveSheet.Shapes(i).Select
　 　 mm2(i) = Selection.Name
　　Next i

　3-1.は、
　'太さの入力
　hutosa = InputBox("太さを入力してください。0.25単位で近いところにします　", , 2)
　hutosa = Int((hutosa * 4 + 0.5)) / 4

　4-1は、
　図形の名前から、ラインまたはコネクタかどうかの判断し、ライン等の場合、太さを修正します。
'コネクタかどうか、ラインかどうか
return_V1 = Selection.ShapeRange.Connector
If (return_V1 = -1) Or InStr(mm2(i), "Line") <> 0 Then
Selection.ShapeRange.Line.Weight = hutosa
End If

　3-2は、
　muki = InputBox("矢印の向きを入力してください。" & vbCrLf & _
　　"０=⇒　なし" & vbCrLf & _
　　"１=⇒　右へ　――→" & vbCrLf & _
　　"２=⇒　左へ　←――" & vbCrLf & _
　　"３=⇒　両方　←―→" & vbCrLf & _
　　"　　" & vbCrLf _
　　, xpos:=2000, ypos:=3000, Default:=1)

　4-2は、
　図形の名前から、ラインまたはコネクタかどうかの判断し、ライン等の場合矢印の向きを修正します。
'コネクタかどうか、ラインかどうか
return_V1 = Selection.ShapeRange.Connector
If (return_V1 = -1) Or InStr(mm2(i), "Line") <> 0 Then
　　　Select Case muki
　　'なし
　　　Case "0"
　　　　Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadNone
　　　　Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadNone
　　'　――→
　　　Case "1"
　　　　Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadNone
　　　　Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
　　'　←――
　　　Case "2"
　　　　Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadTriangle
　　　　Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
　　'　←―→
　　　Case "3"
　　　　Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadTriangle
　　　　Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle
　　　Case Else
　　　　Exit Sub
　　End Select
　End If

　おしまい

　※コマンドとして何を使うのかが核心です。
　　コマンドの意味は、見ていただけばわかると思います

　長くなりましたので、"6.図形に色をつける"は次回に回します・