エクセル・EXCEL・VBA・マクロで息抜き・牛丼チャンネル

 

エクセルのモジュールに以下のテキスト貼り付けると動きます。

Sub ナイトライダー()


Dim i As Integer
Dim ii As Integer
Dim 行 As Integer
Dim 列 As Integer
Dim 繰り返し幅 As Integer
Dim 繰り返し数 As Integer


繰り返し数 = 5
繰り返し幅 = 7
行 = 20
列 = 9

Range("A1").Select


With Cells
.Interior.Pattern = xlSolid
.Interior.PatternColorIndex = xlAutomatic
.Interior.ThemeColor = xlThemeColorLight1
.Interior.TintAndShade = 0
.Interior.PatternTintAndShade = 0
End With

With Range(Cells(行, 列), Cells(行, 列 + 繰り返し幅))
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeLeft).ThemeColor = 2
.Borders(xlEdgeLeft).TintAndShade = 0.499984740745262
.Borders(xlEdgeLeft).Weight = xlThin
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).ThemeColor = 2
.Borders(xlEdgeTop).TintAndShade = 0.499984740745262
.Borders(xlEdgeTop).Weight = xlThin
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).ThemeColor = 2
.Borders(xlEdgeBottom).TintAndShade = 0.499984740745262
.Borders(xlEdgeBottom).Weight = xlThin
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeRight).ThemeColor = 2
.Borders(xlEdgeRight).TintAndShade = 0.499984740745262
.Borders(xlEdgeRight).Weight = xlThin
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideVertical).ThemeColor = 2
.Borders(xlInsideVertical).TintAndShade = 0.499984740745262
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With




Range(Cells(行, 列), Cells(行, 列 + 繰り返し幅)).Interior.Color = 255

Application.Wait [Now() + "00:00:01"]

ライト

Application.Wait [Now() + "00:00:01"]

Range(Cells(行, 列), Cells(行, 列 + 繰り返し幅)).Interior.Color = xlSolid

Application.Wait [Now() + "00:00:01"]



Cells(行, 列).Interior.Color = 255


Application.Wait [Now() + "00:00:00.7"]

Cells(行, 列).Interior.Color = 0


For ii = 1 To 繰り返し数 - 4

For i = 1 To 繰り返し幅

Cells(行, 列 + 1).Interior.Color = 255

Application.Wait [Now() + "00:00:00.7"]

Cells(行, 列 + 1).Interior.Color = 0

列 = 列 + 1

Next



For i = 1 To 繰り返し幅

Cells(行, 列 - 1).Interior.Color = 255

Application.Wait [Now() + "00:00:00.7"]

Cells(行, 列 - 1).Interior.Color = 0

列 = 列 - 1

Next

Next



For ii = 1 To 繰り返し数 - 3

For i = 1 To 繰り返し幅

Cells(行, 列 + 1).Interior.Color = 255

Application.Wait [Now() + "00:00:00.4"]

Cells(行, 列 + 1).Interior.Color = 0

列 = 列 + 1

Next



For i = 1 To 繰り返し幅

Cells(行, 列 - 1).Interior.Color = 255

Application.Wait [Now() + "00:00:00.4"]

Cells(行, 列 - 1).Interior.Color = 0

列 = 列 - 1

Next

Next



For ii = 1 To 繰り返し数 - 2

For i = 1 To 繰り返し幅

Cells(行, 列 + 1).Interior.Color = 255

Application.Wait [Now() + "00:00:00.2"]

Cells(行, 列 + 1).Interior.Color = 0

列 = 列 + 1

Next



For i = 1 To 繰り返し幅

Cells(行, 列 - 1).Interior.Color = 255

Application.Wait [Now() + "00:00:00.2"]

Cells(行, 列 - 1).Interior.Color = 0

列 = 列 - 1

Next

Next



For ii = 1 To 繰り返し数

For i = 1 To 繰り返し幅

Cells(行, 列 + 1).Interior.Color = 255

Application.Wait [Now() + "00:00:00.08"]

Cells(行, 列 + 1).Interior.Color = 0

列 = 列 + 1

Next



For i = 1 To 繰り返し幅

Cells(行, 列 - 1).Interior.Color = 255

Application.Wait [Now() + "00:00:00.08”]

Cells(行, 列 - 1).Interior.Color = 0

列 = 列 - 1

Next

Next

Range(Cells(行, 列), Cells(行, 列 + 繰り返し幅)).Interior.Color = 255

Application.Wait [Now() + "00:00:01"]

Range(Cells(行, 列), Cells(行, 列 + 繰り返し幅)).Interior.Color = 300


ライト消灯

Application.Wait [Now() + "00:00:01"]

With Cells
.Interior.Pattern = xlSolid
.Interior.PatternColorIndex = xlAutomatic
.Interior.ThemeColor = xlThemeColorLight1
.Interior.TintAndShade = 0
.Interior.PatternTintAndShade = 0
End With

With Cells
.Interior.Pattern = xlNone
.Interior.TintAndShade = 0
.Interior.PatternTintAndShade = 0
End With

Application.Wait [Now() + "00:00:01"]

With Cells
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With




End Sub
Sub ライト()


iiii = 20

For iii = 1 To 7
With Range(Cells(iiii, 4), Cells(20, 6))
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeLeft).ColorIndex = 0
.Borders(xlEdgeLeft).TintAndShade = 0
.Borders(xlEdgeLeft).Weight = xlThin

.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).ColorIndex = 0
.Borders(xlEdgeTop).TintAndShade = 0
.Borders(xlEdgeTop).Weight = xlThin

.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).ColorIndex = 0
.Borders(xlEdgeBottom).TintAndShade = 0
.Borders(xlEdgeBottom).Weight = xlThin

.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeRight).ColorIndex = 0
.Borders(xlEdgeRight).TintAndShade = 0
.Borders(xlEdgeRight).Weight = xlThin

.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
.Interior.Pattern = xlSolid
.Interior.PatternColorIndex = xlAutomatic
.Interior.ThemeColor = xlThemeColorDark1
.Interior.TintAndShade = 0
.Interior.PatternTintAndShade = 0
End With

With Range(Cells(iiii, 19), Cells(20, 21))
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeLeft).ColorIndex = 0
.Borders(xlEdgeLeft).TintAndShade = 0
.Borders(xlEdgeLeft).Weight = xlThin

.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).ColorIndex = 0
.Borders(xlEdgeTop).TintAndShade = 0
.Borders(xlEdgeTop).Weight = xlThin

.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).ColorIndex = 0
.Borders(xlEdgeBottom).TintAndShade = 0
.Borders(xlEdgeBottom).Weight = xlThin

.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeRight).ColorIndex = 0
.Borders(xlEdgeRight).TintAndShade = 0
.Borders(xlEdgeRight).Weight = xlThin

.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
.Interior.Pattern = xlSolid
.Interior.PatternColorIndex = xlAutomatic
.Interior.ThemeColor = xlThemeColorDark1
.Interior.TintAndShade = 0
.Interior.PatternTintAndShade = 0
End With

iiii = iiii - 1

Application.Wait [Now() + "00:00:00.05"]

Next

End Sub


Sub ライト消灯()


iiii = 14

For iii = 1 To 7
With Range(Cells(iiii, 4), Cells(20, 6))
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeLeft).ColorIndex = 0
.Borders(xlEdgeLeft).TintAndShade = 0
.Borders(xlEdgeLeft).Weight = xlThin

.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).ColorIndex = 0
.Borders(xlEdgeTop).TintAndShade = 0
.Borders(xlEdgeTop).Weight = xlThin

.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).ColorIndex = 0
.Borders(xlEdgeBottom).TintAndShade = 0
.Borders(xlEdgeBottom).Weight = xlThin

.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeRight).ColorIndex = 0
.Borders(xlEdgeRight).TintAndShade = 0
.Borders(xlEdgeRight).Weight = xlThin

.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
.Interior.Pattern = xlSolid
.Interior.PatternColorIndex = xlAutomatic
.Interior.ThemeColor = xlThemeColorDark1
.Interior.TintAndShade = 0
.Interior.PatternTintAndShade = 0
End With
With Range(Cells(iiii, 4), Cells(iiii, 6))
.Interior.Pattern = xlSolid
.Interior.PatternColorIndex = xlAutomatic
.Interior.ThemeColor = xlThemeColorLight1
.Interior.TintAndShade = 0
.Interior.PatternTintAndShade = 0
End With

With Range(Cells(iiii, 19), Cells(20, 21))
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeLeft).ColorIndex = 0
.Borders(xlEdgeLeft).TintAndShade = 0
.Borders(xlEdgeLeft).Weight = xlThin

.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeTop).ColorIndex = 0
.Borders(xlEdgeTop).TintAndShade = 0
.Borders(xlEdgeTop).Weight = xlThin

.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeBottom).ColorIndex = 0
.Borders(xlEdgeBottom).TintAndShade = 0
.Borders(xlEdgeBottom).Weight = xlThin

.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeRight).ColorIndex = 0
.Borders(xlEdgeRight).TintAndShade = 0
.Borders(xlEdgeRight).Weight = xlThin

.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
.Interior.Pattern = xlSolid
.Interior.PatternColorIndex = xlAutomatic
.Interior.ThemeColor = xlThemeColorDark1
.Interior.TintAndShade = 0
.Interior.PatternTintAndShade = 0
End With
With Range(Cells(iiii, 19), Cells(iiii, 21))
.Interior.Pattern = xlSolid
.Interior.PatternColorIndex = xlAutomatic
.Interior.ThemeColor = xlThemeColorLight1
.Interior.TintAndShade = 0
.Interior.PatternTintAndShade = 0
End With

iiii = iiii + 1

Application.Wait [Now() + "00:00:00.05"]

Next

End Sub