ゴリラストロングの雑記帳

月収10万円の広告収入を目指す自称専業ライターのブログです。




【VBA】複数種類のオートシェイプを用いたガントチャートを作成するマクロ。




どうも、ゴリラストロングです。 

 

複数種類のオートシェイプを用いたガントチャートを作成するマクロを作成しました。

 

以下が元データです。 

 

f:id:gorilla-strong:20200222201625p:plain

 

f:id:gorilla-strong:20200222201643p:plain

  

マクロ実行後が以下です。

f:id:gorilla-strong:20200222201715p:plain

  

以下がソースコードです。

Sub ウイルス感染者の状況()

Dim JK, GC As Object
    Set JK = Workbooks("ゴリラストロングの雑記帳.xlsm").Worksheets("ウイルス感染者の状況")
    Set GC = Workbooks("ゴリラストロングの雑記帳.xlsm").Worksheets("ガントチャート")

Dim lastrowJK As Long
    lastrowJK = JK.Cells(Rows.Count, 1).End(xlUp).Row

Dim lastrowGC As Long
    lastrowGC = GC.Cells(Rows.Count, 1).End(xlUp).Row



For i = 4 To lastrowJK



Dim name As String
    name = JK.Range("A" & i)

Dim namerow As Long
    namerow = GC.Columns(1).Find(name).Row






Dim HKhiduke As String
    HKhiduke = JK.Range("B" & i)

Dim HKB As Long
    HKB = GC.Rows(1).Find(What:=DateValue(HKhiduke)).Column

Dim sp As Shape
    Set sp = GC.Shapes.AddShape(msoShapeExplosion1, Cells(namerow, HKB).Left, Cells(namerow, HKB).Top, 30, Cells(namerow, HKB).Height)
    sp.Fill.ForeColor.SchemeColor = 10




Dim Nhiduke As String
    Nhiduke = JK.Range("C" & i)

Dim NIB As Long
    NIB = GC.Rows(1).Find(What:=DateValue(Nhiduke)).Column

Dim Thiduke As String
    Thiduke = JK.Range("D" & i)

Dim TIB As Long
    TIB = GC.Rows(1).Find(What:=DateValue(Thiduke)).Column

Dim Bar As Shape
    Set Bar = ActiveSheet.Shapes.AddShape _
                                (msoShapeRightArrow, _
                                 Cells(namerow, NIB).Left, _
                                 Cells(namerow, NIB).Top, _
                                 Cells(namerow, TIB).Left - Cells(namerow, NIB).Left, _
                                 Cells(namerow, NIB).Height)
    Bar.Fill.ForeColor.SchemeColor = 5










Dim AKhiduke As String
    AKhiduke = JK.Range("E" & i)

Dim AKK As Long
    AKK = GC.Rows(1).Find(What:=DateValue(AKhiduke)).Column

Dim AShiduke As String
    AShiduke = JK.Range("F" & i)

Dim AKS As Long
    AKS = GC.Rows(1).Find(What:=DateValue(AShiduke)).Column

Dim Bar2 As Shape
    Set Bar2 = ActiveSheet.Shapes.AddShape _
                                (msoShapeRightArrow, _
                                 Cells(namerow, AKK).Left, _
                                 Cells(namerow, AKK).Top, _
                                 Cells(namerow, AKS).Left - Cells(namerow, AKK).Left, _
                                 Cells(namerow, AKK).Height)
    Bar2.Fill.ForeColor.SchemeColor = 4






Dim KChiduke As String
    KChiduke = JK.Range("G" & i)

Dim KCB As Long
    KCB = GC.Rows(1).Find(What:=DateValue(KChiduke)).Column

Dim sp2 As Shape
    Set sp2 = GC.Shapes.AddShape(msoShapeHeart, Cells(namerow, KCB).Left, Cells(namerow, KCB).Top, 30, Cells(namerow, KCB).Height)
    sp2.Fill.ForeColor.SchemeColor = 6



    Next

End Sub

 

 

※こちらガントチャート作成関係の別記事です。

 是非ご覧になってみてください。 

gorilla-strong.hatenablog.com

 

 

最後までご覧いただきありがとうございました。 

以上、ゴリラストロングでした。