Café wall illusion

先日エクセルで描いたカフェウォール錯視を、VB Scriptでエクセルに描くようにしてみました。
コードをテキストファイルにコピペして、拡張子を「.vbs」に変更してダブルクリックすると動きます。

コード

    Option Explicit

    Call Main()

'** Subroutine ********************************************'
    Sub Main()
        'エクセルの起動'
        Dim Excel_app
        Set Excel_app = CreateExcel()
        If Excel_app Is Nothing Then
            Msgbox "Excelの起動に失敗しました。"
            Exit Sub
        End If
        '定数をセット'
        Const xlWBATWorksheet = -4167
        Const xlEdgeBottom = 9
        Const xlContinuous = 1
        Const xlThin = 2
        'エクセルでの処理'
        With Excel_app
            Dim wb, ws    
            Set wb = .Application.WorkBooks.Add(xlWBATWorksheet)
            Set ws = wb.Worksheets(1)
            
            With ws
                .Name = "カフェウォール錯視"
                .Cells.ColumnWidth = 0.58
                .Range("A1:D1").Interior.Color = vbBlack
                .Range("E1:H1").Interior.Color = vbWhite
                Dim r
                Set r = .Range("A1:H1")
                '罫線の設定'
                With r.Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .Color = RGB(128,128,128)
                End With
                Dim i
                '8セルを１セットにして１列作成'
                Do While i < 24
                    r.Copy r.Offset(0,8)
                    Set r = r.Offset(0,8)
                    i = i + 1
                Loop
                '１列目をずらしながら行方向にコピー'
                Set r = .Range(.Cells(1,1), .Cells(1,i*8))
                Dim j
                For i = 1 to 24
                    If (i Mod 4)=0 Then
                        j = 0
                    Else
                        j = 2 - (i Mod 2)
                    End If
                    r.Copy r.Offset(i,j)
                Next
            End With

        End With
        Msgbox "処理完了"
    End Sub

'** Function **********************************************'
'============================'
    Function CreateExcel()
'============================'
        Set CreateExcel = Nothing
        Dim objXL, i
        Set objXL = CreateObject("Excel.Application")
        i = 0
        Do While objXL Is Nothing
            i = i + 1
            If i > 5 Then
                Exit Function
            Else
                WScript.Sleep(600)
            End If
        Loop
        objXL.Visible = True
        Set CreateExcel = objXL
    End Function