VBAでAccessから工程表のシェイプを操作する～その2～

少しだけアイキャッチ画像をがんばってみるというテストです。

センスは気長に磨いていくしかないのでしょうね。

おつかれさまです。なずなです。

今回の処理の中に初心者のときだとハマりどころがあります。

さらっと同じことを思いつかない方はぜひ練習してみてね。

このくらいでも２，３時間かかるのはザラです。

気長にいきましょう。

今回も工程表のシェイプですよ～。

今回の完成品

追加した部分

・図形が日付と連動して列が決定するようになりました。

・幅は予定開始～終了まで設定されるようになりました。

コードはこちらです。ぺたっとコピペで動くはず。

Excel部分はがんばってください←

'全てのシェイプが削除されるので注意
Sub シェイプの全削除()
    Dim shp As Shape
    Dim sh As Worksheet
    
    Set sh = TageSH()
    
    
    For Each shp In sh.Shapes
        shp.Delete
    Next
    
End Sub

Sub 予定の開始と終了日付の幅でシェイプを配置する()
    Dim sh As Worksheet
    
    Set sh = TageSH
    
    'A1セルに作成
    予定シェイプの作成 sh, 1, 1, 50
    
    Dim col As Long
    Dim endCol As Long
    Dim i As Long
    Dim statday
    Dim endday
    
    For i = 5 To 15
        '対象行の開始行を取得
        statday = sh.Cells(i, 8).Value
        endday = sh.Cells(i, 9).Value
        
        Dim x As Long
        
        x = 13
        Do While sh.Cells(3, x).Value <> ""
        
            '試しに表示はしてみましょう
            'Debug.Print sh.Cells(3, x).Value
        
            '日付が一致したら列を代入
            If statday = sh.Cells(3, x) Then
                col = sh.Cells(3, x).Column
            End If
            
            '同日がありえるのでelseifは使わない
            If endday = sh.Cells(3, x) Then
                endCol = sh.Cells(3, x).Column
            End If
        
            x = x + 1
        Loop
        
        '不要になったので削除
        'col = 13 + i - 5
    
        '日付の差計算。0になるので1日足しておく
        '年末年始をまたぐときは年の変え忘れに注意
        Dim 日付差
        日付差 = DateDiff("d", statday, endday) + 1
        
        '
        Debug.Print 日付差
        
        '日付の幅は固定だとしてM列（13)を利用
        予定シェイプの作成 sh, i, col, sh.Cells(i, 13).Width * 日付差
    Next
    
    
End Sub

Sub 予定シェイプの作成(ByVal sh As Worksheet, ByVal top, ByVal left, ByVal w)
  
    
    Set shp = sh.Shapes.AddShape(msoShapeRectangle, 1, 1, 15, 15)
    
    '高さ
     shp.Height = 10
     
    '幅
     shp.Width = w
    
    '位置
     shp.top = Cells(top, left).top
     '相対移動
     shp.IncrementTop 5
     shp.left = Cells(top, left).left

End Sub

'該当シートを返す
Function TageSH()
    Dim bk As Workbook
    
    Set bk = ThisWorkbook
    
    Dim sh As Worksheet
    
    Set sh = bk.Worksheets("工程表")
    
    Set TageSH = sh

End Function

それでは以下は作成順番です。

ちょっとずつ作っていくのがコツですよ～。

シェイプを全削除する処理を作る

最初から直接は関係がない処理ですが大事です

前回のを何度か試した人はわかるはず。

作成の処理を何回もするとどんどん重なっていくのです。

ひとまず手作業はしんどいので、削除をさらっと作ります。

'全てのシェイプが削除されるので注意
Sub シェイプの全削除()
    Dim shp As Shape
    Dim sh As Worksheet
    
    Set sh = TageSH()
    
    For Each shp In sh.Shapes
        shp.Delete
    Next
    
End Sub

'該当シートを返す
Function TageSH()
    Dim bk As Workbook
    
    Set bk = ThisWorkbook
    
    Dim sh As Worksheet
    
    Set sh = bk.Worksheets("工程表")
    
    Set TageSH = sh

End Function

あとあとの変更に向けてブックとシートを返す関数にしてます。

以降は省略するので注意してください。

複数オブジェクトをFor Eachループで1個ずつ取り出して、

英語から想像できるdeleteメソッドで消去です。

1点注意点として、これは全削除です。

人の作ったExcelだと罫線が図で作られていたり、

思わぬところで使われているものです。

あくまでデバッグ用にしましょう。

予定シェイプの列を日付にあわせる

まずは開始日からスタートするように作り直します。

Sub ループで動的な位置にシェイプを配置する()
    Dim sh As Worksheet
    
    Set sh = TageSH
    
    'A1セルに作成
    予定シェイプの作成 sh, 1, 1, 50
    
    Dim col As Long
    Dim i As Long
    Dim tageday
    
    For i = 5 To 15
        '対象行の開始行を取得
        tageday = sh.Cells(i, 8).Value
        
        Dim x As Long
        
        x = 13
        Do While sh.Cells(3, x).Value <> ""
        
            '試しに表示はしてみましょう
            'Debug.Print sh.Cells(3, x).Value
        
            '日付が一致したら列を代入
            If tageday = sh.Cells(3, x) Then
                col = sh.Cells(3, x).Column
            End If
        
            x = x + 1
        Loop
        
        '不要になったので削除
        'col = 13 + i - 5
    
        '
        予定シェイプの作成 sh, i, col, 50
    Next
End Sub

わたしが初心者さんには九九の二重ループを確認する理由のひとつです。

行のループがスタートしてから特定列の日付を変数に格納。

日付列のループを初めて一致したらそこがシェイプの置きたい位置です。

開始完了日付までの幅に変更する

幅は固定されてしまっていたので、終了日までに変更します。

さっきは開始日だけ取得しましたがよく考えたら終了日も必要です。

細かい設計してから作らないときはこういうのはあるあるです。

気にせず修正しましょう。

Sub 予定の開始と終了日付の幅でシェイプを配置する()
    Dim sh As Worksheet
    
    Set sh = TageSH
    
    'A1セルに作成
    予定シェイプの作成 sh, 1, 1, 50
    
    Dim col As Long
    Dim endCol As Long
    Dim i As Long
    Dim statday
    Dim endday
    
    For i = 5 To 15
        '対象行の開始行を取得
        statday = sh.Cells(i, 8).Value
        endday = sh.Cells(i, 9).Value
        
        Dim x As Long
        
        x = 13
        Do While sh.Cells(3, x).Value <> ""
        
            '試しに表示はしてみましょう
            'Debug.Print sh.Cells(3, x).Value
        
            '日付が一致したら列を代入
            If statday = sh.Cells(3, x) Then
                col = sh.Cells(3, x).Column
            End If
            
            '同日がありえるのでelseifは使わない
            If endday = sh.Cells(3, x) Then
                endCol = sh.Cells(3, x).Column
            End If
        
            x = x + 1
        Loop
        
        '不要になったので削除
        'col = 13 + i - 5
    
        '日付の差計算。0になるので1日足しておく
        '年末年始をまたぐときは年の変え忘れに注意
        Dim 日付差
        日付差 = DateDiff("d", statday, endday) + 1
        
        '
        Debug.Print 日付差
        
        '日付の幅は固定だとしてM列（13)を利用
        予定シェイプの作成 sh, i, col, sh.Cells(i, 13).Width * 日付差
    Next
End Sub

完成品でも使われているのはこちらです。

ポイントは3つ

1. statday と endday の変数を作ってそれぞれ取得

2. 日付差を取得するdatediffを利用

3. 開始日終了日が同じはありえるので、1足しておく

3とは案外わすれがちです。

2は覚えるのみ！！

日付操作ということでぐぐりましょう。

バグチェック

ここらで日付をいろいろ変更したりしてみて

いろいろ試してみましょう。

日付が空白だったらどうなるんだろとか思った人はするどい！

今の段階では気にしなくていいです。

だんだんブログで見るにはしんどくなっている気がしますが、

次回はAccessに乗せ換えてみます。

またみてね～。