[[20110327110746]]　『図形と図形を矢印でつなげる』（koko）　ページの最後に飛ぶ

『図形と図形を矢印でつなげる』（koko）

 お世話になります。
図形を作成して図形のテキストをセルに入力された値にするコードです。
調べ調べ、どうにか書けたのですが　次にこの図形達を矢印の図形
（直線矢印コネクタ 1707）で結びたいのですが、全く進みません。
どう書けばいいのかお教え下さい。
宜しくお願い致します。

 Sub 図形作成()
Dim i As Integer
Dim j As Integer
Application.ScreenUpdating = False
For j = 2 To 11
    For i = 4 To 15
        Cells(j, i).Select
        If Cells(j, i).Value = "" Then
        Else
        ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, ActiveCell.Left, ActiveCell.Top, 90#, 40#).Select
        Selection.Characters.Text = ActiveCell.Value
        Selection.ShapeRange.Line.Weight = 1.2
        Selection.ShapeRange.Fill.ForeColor.SchemeColor = 1        
        With Selection.Font
            .Name = "ＭＳ Ｐゴシック"
            .FontStyle = "標準"
            .Size = 11
            .ColorIndex = 1
        End With
       End If
    Next i
 Next j
Range("c1").Select
Application.ScreenUpdating = True
End Sub

ＯＳ：ＸＰ　エクセル2007

 残念なことに2007ではマクロの記録でここら辺の記録が取れないようですね。
 (2010で復活したようです。)
 ネットで検索すれば例はありますので、「直線矢印コネクタ」という正確な用語が
 分かっているのでしたら、調べれば参考になるコードは見つかると思います。

 今回はどのように線をつなぐかの説明がありませんでしたので、単純に縦につないだ例です。
 Sub 図形作成()
    Dim r As Long
    Dim c As Long
    Dim sSh As Shape
    Dim eSh As Shape
    Dim cRng As Range

    Application.ScreenUpdating = False
    For c = 4 To 15
        Set sSh = Nothing
        For r = 2 To 11
            Set cRng = Cells(r, c)
            If cRng.Value <> "" Then
                Set eSh = ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, cRng.Left, cRng.Top, 90#, 40#)
                eSh.TextFrame.Characters.Text = cRng.Value
                eSh.Line.Weight = 1.2
                eSh.Fill.ForeColor.SchemeColor = 1
                With eSh.TextFrame.Characters.Font
                    .Name = "ＭＳ Ｐゴシック"
                    .FontStyle = "標準"
                    .Size = 11
                    .ColorIndex = 1
                End With
                If Not sSh Is Nothing Then
                    ConnectShape sSh, eSh
                End If
                Set sSh = eSh
            End If
        Next
    Next
    Application.ScreenUpdating = True
 End Sub

 Sub ConnectShape(startSh, endSh)
    Dim lineShape
    Set lineShape = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, 416.25, 120#, 3#, 35.25)
    lineShape.Flip msoFlipHorizontal
    lineShape.Flip msoFlipVertical
    lineShape.ConnectorFormat.BeginConnect startSh, 3
    lineShape.ConnectorFormat.EndConnect endSh, 1
    lineShape.Line.EndArrowheadStyle = msoArrowheadTriangle
 End Sub
 (Mook)

 Mookさんへ
説明不足で大変申し訳ありません。
ご提示のコードは線が縦ですが
この線を横にしていただけないですか？
msoConnectorStraight(この直線）を矢印線（→）に帰るのは調べれば
何とかなりそうな気がしますが
縦を横に変えるのは自信ありません。
コードの加工にチャレンジもしないで大変心苦しいのですが
この機を逃さずにコードを確保したいという気持ちが先に走っています。
 (koko)

 >コードの加工にチャレンジもしないで大変心苦しいのですが
 >この機を逃さずにコードを確保したいという気持ちが先に走っています。
 まぁ、ある意味正直なのかもしれませんがｗ、やはりコードを理解しましょうよ。

 線を結んでいるのは
    lineShape.ConnectorFormat.BeginConnect startSh, 3
    lineShape.ConnectorFormat.EndConnect endSh, 1
 の部分ですが、
    最後の引数が接続位置です。
    1・・・図形の上の点
    2・・・図形の左の点
    3・・・図形の下の点
    4・・・図形の右の点
 なので、どう変えればいいかはわかりますよね？
 上の行が開始のShape、下の行が終端のShapeです。

 あとは、縦ではなく横に処理するために
    For c = 4 To 15
           :
        For r = 2 To 11
           :
 を
    For r = 2 To 11
           :
        For c = 4 To 15
           :
 のように入れ替えて完成です。

 分からない点はフォローしますから、がんばってみてください。
 ～～～～
 追伸：
 先のコードで矢印の修正はしています。
    lineShape.Line.EndArrowheadStyle = msoArrowheadTriangle
 がそれです。
 (Mook)

 Mookさんへ
自力ではなく、教えてもらっての結果とはいえ　加工ができました
これで作業時間が格段に短縮できます。誠に助かります。
有難うございました。
　（koko)

コメント返信：

[ 一覧(最新更新順) ]

[[20110327110746]] 『図形と図形を矢印でつなげる』（koko） ページの最後に飛ぶ

[[20110327110746]]　『図形と図形を矢印でつなげる』（koko）　ページの最後に飛ぶ