【エクセルマクロ】鬼滅の刃の羽織柄を作ってみた_背景色を塗る

エクセルマクロで効率化する

エクセルマクロで、鬼滅の刃の羽織柄を作るVBAコードをご紹介します。

公式な色合いではないかもしれませんが、キャラクターの写真からRGBを出して作りました。

このページのマクロコードは、コピペで使えます。
せひ、お試しください。

鬼滅の刃の羽織柄を作ってみた(竈門炭治郎)

以下のマクロを実行すると、背景色を竈門炭治郎の市松柄に塗りつぶします。

Sub 竈門炭治郎の羽織柄の市松模様()
 
Dim MyRow As Integer
Dim MyColomn As Integer
     
  '緑
  For MyRow = 1 To 9 Step 2
    For MyColomn = 1 To 9 Step 2
      Cells(MyRow, MyColomn).Interior.Color = RGB(79, 172, 135)
      Cells(MyRow, MyColomn).Offset(0, 1).Offset(1, 0).Interior.Color = RGB(79, 172, 135)
    Next
  Next
      
  '黒
  For MyRow = 2 To 10 Step 2
    For MyColomn = 1 To 10 Step 2
      Cells(MyRow, MyColomn).Interior.Color = RGB(41, 37, 34)
      Cells(MyRow, MyColomn).Offset(-1, 0).Offset(0, 1).Interior.Color = RGB(41, 37, 34)
    Next
  Next
         
End Sub

 

マクロ実行後

背景色を市松模様に着色しました。


 
 

鬼滅の刃の羽織柄を作ってみた(我妻善逸)

以下のマクロを実行すると、背景色を我妻善逸の着物の模様に塗りつぶします。

Sub 我妻善逸の羽織柄のデザイン()

Dim StartX As Single
Dim StartY As Single
Dim EndX As Single
Dim EndY As Single
Dim i As Long
Dim j As Long

  '背景色
  Range(Cells(1, 1), Cells(11, 11)).Interior.Color = RGB(253, 165, 64)
    
  '三角を挿入①
  For i = 2 To 10 Step 4
      For j = 2 To 10 Step 4
  
      With Cells(i, j)
        StartX = .Left
        StartY = .Top
        EndX = .Offset(0, 1).Left - .Left
        EndY = .Height
            
        '図形挿入
        ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, StartX, StartY, EndX, EndY).Select
        With Selection.ShapeRange
            .Fill.ForeColor.RGB = RGB(243, 244, 241)
            .Line.ForeColor.RGB = msoThemeColorText1
            .Line.Weight = 0.1
        End With
        
      End With
   
      Next j
  Next i
    
  '三角を挿入②
  For i = 4 To 10 Step 4
      For j = 4 To 10 Step 4
  
      With Cells(i, j)
        StartX = .Left
        StartY = .Top
        EndX = .Offset(0, 1).Left - .Left
        EndY = .Height
            
        '図形挿入
        ActiveSheet.Shapes.AddShape(msoShapeIsoscelesTriangle, StartX, StartY, EndX, EndY).Select
        With Selection.ShapeRange
            .Fill.ForeColor.RGB = RGB(233, 243, 244)
            .Line.ForeColor.RGB = msoThemeColorText1
            .Line.Weight = 0.1
        End With
       
      End With
    
      Next j
  Next i
        
End Sub

 

マクロ実行後

背景色をオレンジ色にして、白に近い色の三角を入れました。


 

Excelの行の高さは「12」に設定しています。

 

Excelの列の幅は「3」に設定しています。

 

行列の幅は、お好みの長さに手作業で調整していただければと思います。
 

鬼滅の刃の羽織柄を作ってみた(竈門禰豆子)

以下のマクロを実行すると、背景色を竈門禰豆子の着物の麻の葉模様に塗りつぶします。

Sub 竈門禰豆子の羽織の模様()

Dim StartX(20) As Single
Dim StartY(20) As Single
Dim EndX(20) As Single
Dim EndY(20) As Single
Dim i As Long

    '背景色
    Range(Cells(1, 1), Cells(11, 17)).Interior.Color = RGB(221, 166, 187)
        
    '斜め線
    With Cells(2, 4)
        StartX(1) = .Left
        StartY(1) = Cells(3, 3).Top + .Height
        EndX(1) = .Offset(0, 1).Left
        EndY(1) = .Offset(0, 1).Top
        
        StartX(2) = .Left
        StartY(2) = .Offset(0, 1).Top
        EndX(2) = .Offset(0, 1).Left
        EndY(2) = Cells(3, 3).Top + .Height
    End With
    
    '斜め線
    With Cells(2, 2)
        StartX(3) = .Left
        StartY(3) = .Offset(0, 1).Top
        EndX(3) = .Offset(0, 5).Left
        EndY(3) = Cells(3, 3).Top + .Height

        StartX(4) = .Left
        StartY(4) = .Top
        EndX(4) = .Offset(0, 1).Left
        EndY(4) = .Offset(1, 0).Top

        StartX(5) = .Left
        StartY(5) = .Top
        EndX(5) = .Offset(0, 2).Left
        EndY(5) = .Offset(0, 2).Top
    End With

    '斜め線
    With Cells(3, 2)
        StartX(6) = .Left
        StartY(6) = .Offset(1, 0).Top
        EndX(6) = Cells(2, 7).Left
        EndY(6) = Cells(2, 7).Height

        StartX(7) = .Left
        StartY(7) = .Top + .Height
        EndX(7) = .Offset(0, 1).Left
        EndY(7) = .Offset(0, 1).Top

        StartX(8) = .Offset(0, 1).Left
        StartY(8) = .Offset(0, 1).Top
        EndX(8) = .Offset(0, 1).Offset(0, 3).Left
        EndY(8) = .Offset(0, 1).Offset(0, 3).Top
    End With
    
    '斜め線
    With Cells(2, 6)
        StartX(9) = .Left
        StartY(9) = .Top + .Height
        EndX(9) = .Offset(0, 1).Left
        EndY(9) = .Offset(0, 1).Top

        StartX(10) = .Offset(1, 0).Left
        StartY(10) = .Offset(1, 0).Top
        EndX(10) = .Offset(1, 0).Offset(0, 1).Left
        EndY(10) = .Offset(1, 0).Offset(1, 0).Top

        StartX(11) = .Offset(0, -1).Left
        StartY(11) = .Offset(0, -1).Top
        EndX(11) = .Offset(0, -1).Offset(0, 2).Left
        EndY(11) = .Offset(0, -1).Offset(0, 2).Top
    End With
        
    '横線
    With Cells(4, 2)
        StartX(12) = .Left
        StartY(12) = .Top
        EndX(12) = .Offset(0, 2).Left
        EndY(12) = .Offset(0, 2).Top

        StartX(13) = .Offset(0, 3).Left
        StartY(13) = .Offset(0, 3).Top
        EndX(13) = .Offset(0, 3).Offset(0, 2).Left
        EndY(13) = .Offset(0, 3).Offset(0, 2).Top
    End With
        
    '縦線 セルの中央
    With Cells(11, 4)
        StartX(14) = .Offset(-1, 0).Left + .Height / 2
        StartY(14) = .Offset(-1, 0).Top
        EndX(14) = .Offset(-9, 0).Left + .Height / 2
        EndY(14) = .Offset(-9, 0).Top

        StartX(15) = .Offset(-1, 0).Offset(0, 3).Left
        StartY(15) = .Offset(-1, 0).Offset(0, 3).Top
        EndX(15) = .Offset(0, 3).Offset(-9, 0).Left
        EndY(15) = .Offset(0, 3).Offset(-9, 0).Top
    End With
        
    '縦線 セルの中央
    With Cells(11, 9)
        StartX(16) = .Offset(-1, 0).Left + .Height / 2
        StartY(16) = .Offset(-1, 0).Top
        EndX(16) = .Offset(-9, 0).Left + .Height / 2
        EndY(16) = .Offset(-9, 0).Top
        
        StartX(17) = .Offset(-1, 0).Offset(0, 3).Left
        StartY(17) = .Offset(-1, 0).Offset(0, 3).Top
        EndX(17) = .Offset(0, 3).Offset(-9, 0).Left
        EndY(17) = .Offset(0, 3).Offset(-9, 0).Top
        
        StartX(18) = .Offset(-1, 0).Offset(0, 5).Left + .Height / 2
        StartY(18) = .Offset(-1, 0).Offset(0, 5).Top
        EndX(18) = .Offset(0, 5).Offset(-9, 0).Left + .Height / 2
        EndY(18) = .Offset(0, 5).Offset(-9, 0).Top
    End With
        
    '線を挿入
    For i = 1 To 18
        ActiveSheet.Shapes.AddConnector(msoConnectorStraight, StartX(i), StartY(i), EndX(i), EndY(i)).Select
        Selection.ShapeRange.Line.ForeColor.RGB = RGB(121, 62, 82)
    Next i
    
    '線をコピー
    Range(Cells(2, 2), Cells(6, 6)).Copy Cells(4, 2)
    Range(Cells(2, 2), Cells(6, 6)).Copy Cells(6, 2)
    Range(Cells(1, 2), Cells(10, 6)).Copy Cells(1, 7)
    Range(Cells(1, 2), Cells(10, 6)).Copy Cells(1, 12)
    
    '列幅調整
    Range("A:B,F:G,K:L,P:Q").ColumnWidth = 1#
    Range("D:D,I:I,N:N").ColumnWidth = 1.78
    Range("C:C,E:E,H:H,J:J,M:M,O:O").ColumnWidth = 2.33
    Rows("1:11").RowHeight = 18.75

End Sub

 

マクロ実行後

セルの背景色をピンクに着色し、罫線を引いて麻の葉模様を描きました。

罫線をたくさん引いたので、その分VBAコードが長くなりました。

Excelの設定条件によって、形が崩れてしまうことがあるようです。

そんな時は、列幅を調節してみてください。


 
 

鬼滅の刃の帯の柄を作ってみた(竈門禰豆子)

以下のマクロを実行すると、背景色を竈門禰豆子の市松柄に塗りつぶします。

Sub 竈門禰豆子の帯の市松模様()
  
Dim MyRow As Integer
Dim MyColomn As Integer
      
  '白
  For MyRow = 1 To 9 Step 2
    For MyColomn = 1 To 9 Step 2
      Cells(MyRow, MyColomn).Interior.Color = RGB(251, 242, 239)
      Cells(MyRow, MyColomn).Offset(0, 1).Offset(1, 0).Interior.Color = RGB(251, 242, 239)
    Next
  Next
       
  '赤茶
  For MyRow = 2 To 10 Step 2
    For MyColomn = 1 To 10 Step 2
      Cells(MyRow, MyColomn).Interior.Color = RGB(154, 49, 72)
      Cells(MyRow, MyColomn).Offset(-1, 0).Offset(0, 1).Interior.Color = RGB(154, 49, 72)
    Next
  Next
          
End Sub

 

マクロ実行後

背景色を市松模様に着色しました。


 
 

以上ご覧いただきましてありがとうございます。