ガントチャート　VBA　描写について

前提・実現したいこと

開始日と終了日が入力されている行のみ塗りつぶしを行いたい。
ボタンを押さなくても入力後エンターキーで実行できるようにする方法があるのかどうか。

発生している問題・エラーメッセージ

開始日と終了日を入力していない行も塗りつぶされるので、どの部分を修正したらいいのかわからない。
また、38行目にも開始日と終了日を入力しましたが、塗りつぶされないが、修正方法がわからない。

該当のソースコード

Sub ガントチャート描写()

'オートシェイプ一括消去
Call オートシェイプ一括消去

'予定日程バー追加
Call 予定日程バー追加

End Sub
Private Sub オートシェイプ一括消去()

Dim shp As Shape

For Each shp In ActiveSheet.Shapes
    
    If shp.Type = msoFormControl Then
        'マクロ実行ボタンである場合は何もしない
    Else
        shp.Delete  'マクロ実行ボタンでない図形は消去
    End If

Next shp

End Sub

Private Sub 予定日程バー追加()

Dim ws1 As Worksheet
Dim i As Long
Dim st As Range, en As Range
Dim dayEnd As Long, rowEnd As Long
Dim rngStart As Range, rngEnd As Range
Dim xStart As Single, yStart As Single, xEnd As Single, x As Single, y As Single

    Set ws1 = ActiveSheet
           
        With ws1
        dayEnd = .Cells(4, Columns.Count).End(xlToLeft).Column 'カレンダー上の最終日付列の取得
        rowEnd = .Cells(Rows.Count, 2).End(xlUp).Row 'タスク最終行の取得
        
            On Error Resume Next
            For i = 2 To rowEnd
                                       
                '開始日と終了日の対応列を設定する
                Set st = .Cells(4, WorksheetFunction.Match(.Cells(i, 4), .Range(.Cells(4, 1), .Cells(4, dayEnd)), 0)) '開始日のカレンダー上での対応列を設定
                Set en = .Cells(4, WorksheetFunction.Match(.Cells(i, 5), .Range(.Cells(4, 1), .Cells(4, dayEnd)), 0)) '終了日のカレンダー上での対応列を設定
                                
                '開始日と終了日の両方が見つかればバーを描写する
                Set rngStart = .Cells(i, st.Column) 'バーの描写開始セルの設定
                Set rngEnd = .Cells(i, en.Column + 1) 'バーの描写終了セルの１日後を設定
                
                xStart = rngStart.Left  'バーの描写開始位置のX座標
                yStart = rngStart.Top 'バーの描写開始位置のY座標
                xEnd = rngEnd.Left 'バーの描写終了位置のX座標
                y = rngEnd.Height 'バーの高さの方向の幅
                
                With .Shapes.AddShape(msoShapeRectangle, xStart, yStart, xEnd - xStart, y) 'オートシェイプでバーを追加
                    .Fill.ForeColor.RGB = RGB(160, 229, 133) 'バーの色を指定
                    .Line.ForeColor.RGB = RGB(255, 255, 255) '枠線の色を指定
                End With
                    
            Next i '次の行へ
        End With

End Sub

試したこと

上記のコードで実行しています。
インターネットで見たサンプルを参考にしました。
現在の実行後の画面です。

補足情報（FW/ツールのバージョンなど）

行動規範の内容に同意します

回答2件

開始日と終了日が入力されている行のみ塗りつぶしを行いたい。

Forループの中の処理を開始日と終了日が入力されているときのみ処理するようにすればよいと思います。

VBA
1For i = 2 To rowEnd
2	If Not IsEmpty(.Cells(i, 4)) And Not IsEmpty(.Cells(i, 5) Then   ' 追加
3
4～省略～
5
6	End If   ' 追加
7Next i '次の行へ
8

ボタンを押さなくても入力後エンターキーで実行できるようにする方法があるのかどうか。

ワークシートのChangeイベントで処理すればよいかと思います。
以下はD列E列を変更したときのみガントチャート描写関数を実行します。

VBA
1Private Sub Worksheet_Change(ByVal Target As Range)
2    If Not Application.Intersect(Target, Range("D:E")) Is Nothing Then
3        Call ガントチャート描写
4    End If
5End Sub

投稿2020/06/19 06:16

ttyp03

総合スコア17000

ベストアンサー

ExcelVBA
1Sub main()
2    With workshhets("試験予定")
3        予定塗りつぶし .Range("G5", .Range("G5").End(xlToRight)), .Range("C11:D22")
4    End With
5End Sub
6
7Sub 予定日塗りつぶし(ByRef rngDays As Range, ByRef rngDate As Range)
8    Dim c As Range
9    Dim rngTarget As Range
10    Dim ixStart As Long
11    Dim ixEnd As Long
12    
13    
14    For Each c In rngDate.Rows
15        ixStart = 0
16        ixEnd = 0
17        c.EntireRow.Interior.ColorIndex = xlNone
18        
19        On Error Resume Next
20        With WorksheetFunction
21            ixStart = .Match(c.Cells(1), rngDays, 0)
22            ixEnd = .Match(c.Cells(2), rngDays, 0)
23        End With
24        On Error GoTo 0
25        
26        If ixStart > 0 And ixEnd > 0 Then
27            Intersect(c.EntireRow, Application.Range(rngDays(ixStart), rngDays(ixEnd)).EntireColumn).Interior.Color = rgbPaleGreen
28        End If
29    Next
30End Sub

子プロシージャには変わるものを与えて、
再利用できるよういするといいかもです。
図形書くのめんどいので塗りつぶしにしました。

＞ボタンを押さなくても入力後エンターキーで実行できるようにする方法があるのかどうか。
条件付き書式設定で塗りつぶせば、
マクロは要らず、入力に対して反応してくれますよ。
(マクロ無効で開かれても動くし。。。。）
（最近便利かと思ってマクロ仕込んで置いたらマクロ無効で開かれて不評を買ってしまった。愚痴）

投稿2020/06/19 08:42