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
051

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) 'MsgBox (act)
    act = Mid(act, 8, 3)
    mode = Worksheets(Sheet1).Cells(i, 2)
    ID = Len(mode)
    If ID = 21 Then
      sx = Val(Mid(mode, 9, 2))
      sy = Val(Mid(mode, 12, 2))
      tx = Val(Mid(mode, 16, 2))
      ty = Val(Mid(mode, 19, 2))
      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 = act
        Selection.Font.Size = 7
      Next j
    End If
  Next i
End Sub