[[20150301192613]]　『商品の進捗をオートシェイプの矢印で表示させたい』（なお）　ページの最後に飛ぶ

『商品の進捗をオートシェイプの矢印で表示させたい。』（なお）

お知恵を拝借したいです。現在、商品の進捗をVBAを使いオートシェイプを使い表示させようとしてますが、どうしてもできません。
どなたかご教授して頂けませんか？

　A　　B　　C　　D　　　E　　F　　G　　H　　i j
1 　2015 　3月
2　　商品　　担当　依頼日　仕上日　　１日　2日 3日　4日
3　aaaa あああ　　 3/1 　3/3 　 → → → →→ →
4 bbb　　いいい 3/2 　3/3　　　　　→ →→ →
5 ccc　　ううう 3/3 　 3/4 　　　　　　　→ →→ →

上記のように作成しています。

どなたか力を貸してください。

＜使用 Excel：Excel2007、使用 OS：WindowsVista ＞

現在、文字の矢印を使用しているところを図形にしたいということでしょうか。
矢印の範囲は、依頼日から仕上日？それとも？

（マナ） 2015/03/01(日) 20:15

そ～です。
矢印の部分を依頼日から仕上げ日まで図形で表示させたいです。

すみませんが宜しくお願いします。

（なお） 2015/03/01(日) 20:31

依頼日と仕上日は同月なのですか。
前月の場合はないのですか。

（マナ） 2015/03/01(日) 20:54

 マクロ案はマナさんにお任せして、数式案です。

 A1   2015
 B1      3      書式   0"月"
 E2:AI2  1～31  書式   0"日"

 E3 =IF(AND(DATE($A$1,$B$1,E$2)>=$C3,DATE($A$1,$B$1,E$2)<=$D3),"➡","")
 をE3:AI5 にコピーし、
 上記範囲のフォントサイズを大きくしてセンタリングで文字色を好きな色に設定。
（Mook） 2015/03/01(日) 20:56

依頼日と仕上げ日は同月のみです。

数式案ありがとうございます。
（なお） 2015/03/01(日) 21:33

こんな感じでしょうか

 Sub test()
    Dim s As Shape
    Dim i As Long
    Dim 開始セル As Range
    Dim 終了セル As Range
    Dim 左端 As Single
    Dim 上端 As Single
    Dim 幅 As Single
    Dim 高さ As Single

    With ActiveSheet
        For Each s In .Shapes
            If s.AutoShapeType = msoShapeRightArrow Then s.Delete
        Next

        For i = 3 To .Cells(.Rows.Count, 1).End(xlUp).Row
            Set 開始セル = .Cells(i, 4 + Day(.Cells(i, 3).Value))
            Set 終了セル = .Cells(i, 4 + Day(.Cells(i, 4).Value))

            左端 = 開始セル.Left
            上端 = 開始セル.Top + 開始セル.Height * 0.2
            幅 = 終了セル.Left + 終了セル.Width - 左端
            高さ = 開始セル.Height * 0.6

            .Shapes.AddShape msoShapeRightArrow, 左端, 上端, 幅, 高さ

        Next
    End With

 End Sub

（マナ） 2015/03/01(日) 21:43

仕上日が未記入の場合もあるなら。

 Sub test()
    Dim s As Shape
    Dim i As Long
    Dim 開始セル As Range
    Dim 終了セル As Range
    Dim 左端 As Single
    Dim 上端 As Single
    Dim 幅 As Single
    Dim 高さ As Single

    With ActiveSheet
        For Each s In .Shapes
            If s.AutoShapeType = msoShapeRightArrow Then s.Delete
        Next

        For i = 3 To .Cells(.Rows.Count, 1).End(xlUp).Row

            If .Cells(i, 4).Value <> "" Then
                Set 開始セル = .Cells(i, 4 + Day(.Cells(i, 3).Value))
                Set 終了セル = .Cells(i, 4 + Day(.Cells(i, 4).Value))

                左端 = 開始セル.Left
                上端 = 開始セル.Top + 開始セル.Height * 0.2
                幅 = 終了セル.Left + 終了セル.Width - 左端
                高さ = 開始セル.Height * 0.6

                .Shapes.AddShape msoShapeRightArrow, 左端, 上端, 幅, 高さ

                Set 開始セル = Nothing
                Set 終了セル = Nothing
            End If
        Next
    End With
　    
 End Sub

（マナ） 2015/03/01(日) 22:28

コメント返信：

[ 一覧(最新更新順) ]

[[20150301192613]] 『商品の進捗をオートシェイプの矢印で表示させたい』（なお） ページの最後に飛ぶ

[[20150301192613]]　『商品の進捗をオートシェイプの矢印で表示させたい』（なお）　ページの最後に飛ぶ