補遺4 | 制御系CAD

図4.9

この割付図は、配布したrcpsp42.xlsmのシートwaritsukeを、シートwaritsuke(2)のように２列に編集したものです。

それではシートwaritsukeにおいて、どれか一つのブロックを表すEXCELの図形を選択し、Cont+Aを押してすべての図形を選択し、DELキーを押して、すべて消去してください。開発タブからVisual Basicを選択して、次のVBAプログラムを指定して、F5を押してください。そうすると上の割付図が得られます。

VBAプログラム

上述のようにすべての図形を消去したシートwaritsukeと、RCPSPの出力CSVファイルを入れたシートrcpsp42を準備されているとして、次のブログラムを考えます。


Sub Waritsuke()
  Worksheets("waritsuke").Activate
  ActiveSheet.DrawingObjects.Delete
  Dim Sheet1 As Variant 
  Sheet1 = "rcpsp42"
  Dim time1 As Integer, time2 As Integer, sp As Integer
  time1 = 2: time2 = 10: sp = 7:
  Dim act As Variant, mode As Variant, ID As Integer, no As Integer
  Dim joban As Integer, sx As Integer, sy As Integer, tx As Integer
  Dim ty As Integer, start As Integer, completion As Integer
  Dim S As Range, Q As Shape
  For i = 2 To 14
    act = Worksheets(Sheet1).Cells(i, 1) 'i=2のとき、act=A11_BLK1_開始
    mode = Worksheets(Sheet1).Cells(i, 2) 'i=2のとき、mode=M[A11]
    ID = Len(mode)
    If ID = 21 Then
      sx = Val(Mid(mode, 9, 2)) 'i=3のとき、M[A11]_[02_02][01_02]
      sy = Val(Mid(mode, 12, 2)) 'i=3のとき、M[A11]_[02_02][01_02]
      tx = Val(Mid(mode, 16, 2)) 'i=3のとき、M[A11]_[02_02][01_02]
      ty = Val(Mid(mode, 19, 2)) 'i=3のとき、M[A11]_[02_02][01_02]
      start = Worksheets(Sheet1).Cells(i, 3) + 1
      completion = Worksheets(Sheet1).Cells(i, 5)
      For j = start - time1 To completion - time1
        Set S = Range(Cells(3 + sp * j + sx, 4 + 1 + sy), _
        Cells(2 + sp * j + sx + tx, 3 + 1 + sy + ty))
        Set Q = ActiveSheet.Shapes.AddShape(1, S.Left, S.Top, _
        S.Width, S.Height)
        Q.Select
        ic = i Mod 6
        Selection.Font.ColorIndex = 1
        If ic = 0 Then
          Q.Fill.ForeColor.RGB = RGB(255, 0, 0)  '赤
        ElseIf ic = 1 Then
          Q.Fill.ForeColor.RGB = RGB(0, 255, 0)  '緑
        ElseIf ic = 2 Then
          Q.Fill.ForeColor.RGB = RGB(0, 0, 255)  '青
          Selection.Font.ColorIndex = 2
        ElseIf ic = 3 Then
          Q.Fill.ForeColor.RGB = RGB(255, 255, 0) '黄
        ElseIf ic = 4 Then
          Q.Fill.ForeColor.RGB = RGB(0, 255, 255) 'シアン
        ElseIf ic = 5 Then
          Q.Fill.ForeColor.RGB = RGB(255, 0, 255) 'マジェンダ
        End If
        Selection.Text = Mid(act, 8, 3) 'act=場所_for_A11
        Selection.Font.Size = 7
      Next j
    End If
  Next i
End Sub