補遺4

図4.9

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

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

VBAプログラム

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


001
002
003
004
005
006
007
008
009
010
011
012
013
014
015
016
017
018
019
020
021
022
023
024
025
026
027
028
029
030
031
032
033
034
035
036
037
038
039
040
041
042
043
044
045
046
047
048
049
050

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