Excelアートで遊んでみる
世の中には「Excelアート」と呼ばれる分野があります。Excelでイラストやデジタルアートを描くのですが、これをExcelで描いたのとにわかには信じられないような超絶技巧作品を描く方がいらっしゃいます。
ご存知の方も多いでしょう。それがこちら。
デジタルとは言え、手動でコツコツ描くわけで作品の出来は個人の力量に依存しますよね。美術の成績が「2」の私には到底無理な話です。
でもでも何かExcelで描いてみたい。ということで生成AIでExcelでイラストを描くVBAを作ってくれないかなと思い立ちました。
花のような模様を描画するスクリプト
1つ目は花のような模様をExcelに描いてくれるVBAスクリプトです。衝撃的な絵でした。私より下手なんじゃないかと💦 作品は掲載しないのでぜひ試してみてください。
Sub DrawFlowerPattern()
Dim ws As Worksheet
Dim centerX As Integer, centerY As Integer
Dim petalLength As Integer, angleStep As Double
Dim i As Integer, x As Double, y As Double
Dim petalColor As Long
' 作業シートを取得
Set ws = ThisWorkbook.Sheets(1)
' 花の中心と花びらの設定
centerX = 20
centerY = 20
petalLength = 10
angleStep = 15 ' 角度の間隔
petalColor = RGB(255, 0, 150) ' ピンク
' 花びらを描画
For i = 0 To 360 Step angleStep
x = centerX + petalLength * Cos(i * Application.Pi / 180)
y = centerY + petalLength * Sin(i * Application.Pi / 180)
' 中心から花びらの端までを線で表現
ws.Cells(centerY, centerX).Interior.Color = RGB(255, 255, 0) ' 黄色 (中心)
ws.Cells(Int(y), Int(x)).Interior.Color = petalColor ' ピンク (花びら)
Next i
MsgBox "花模様の描画が完了しました！"
End Sub
スクリプトの実行方法
Excelを開きます。
Alt + F11 を押してVBAエディタを開きます。
挿入 → 標準モジュール を選び、新しいモジュールを作成します。
上記のスクリプトをコピーして、エディタに貼り付けます。
Alt + F8 を押して、実行したいマクロを選びます。
ひまわりの花を描画するスクリプト
2つ目はひまわり。これも絵が下手に人に自信を持たせるスクリプトになっています！
Sub DrawSunflower()
Dim ws As Worksheet
Dim centerX As Integer, centerY As Integer
Dim radius As Integer
Dim angle As Double
Dim petalLength As Integer, petalWidth As Integer
Dim i As Integer, x As Double, y As Double
' 作業シートを取得
Set ws = ThisWorkbook.Sheets(1)
' ひまわりの中心座標
centerX = 20
centerY = 20
' 花の中心の設定
radius = 4 ' 中心の半径
For i = -radius To radius
For j = -radius To radius
If Sqr(i ^ 2 + j ^ 2) <= radius Then
ws.Cells(centerY + i, centerX + j).Interior.Color = RGB(139, 69, 19) ' 茶色 (中心)
End If
Next j
Next i
' 花びらの設定
petalLength = 10 ' 花びらの長さ
petalWidth = 3 ' 花びらの幅
For angle = 0 To 359 Step 10
For i = 1 To petalLength
x = centerX + i * Cos(angle * Application.Pi / 180)
y = centerY + i * Sin(angle * Application.Pi / 180)
' 花びらの幅を調整
If i >= petalLength - petalWidth Then
ws.Cells(Round(y), Round(x)).Interior.Color = RGB(255, 223, 0) ' 黄色
Else
ws.Cells(Round(y), Round(x)).Interior.Color = RGB(255, 255, 0) ' 明るい黄色
End If
Next i
Next angle
MsgBox "ひまわりの描画が完了しました！"
End Sub
貼り絵風のアートを描画するスクリプト
幾何学模様を描くVBAスクリプトです。下に結果を載せます。
Sub CollageArt()
Dim ws As Worksheet
Dim numShapes As Integer
Dim maxRows As Integer, maxCols As Integer
Dim startRow As Integer, startCol As Integer
Dim shapeHeight As Integer, shapeWidth As Integer
Dim i As Integer, r As Integer, c As Integer
Dim randColor As Long
' 作業シートを設定
Set ws = ThisWorkbook.Sheets(1)
ws.Cells.Clear ' シートを初期化
' シートの行と列の範囲
maxRows = 50
maxCols = 50
' 描画する形状の数
numShapes = 200
' ランダムに形状を描画
For i = 1 To numShapes
' ランダムな位置を決定
startRow = WorksheetFunction.RandBetween(1, maxRows)
startCol = WorksheetFunction.RandBetween(1, maxCols)
' ランダムな形状の大きさを決定
shapeHeight = WorksheetFunction.RandBetween(1, 5) ' 高さ（セル数）
shapeWidth = WorksheetFunction.RandBetween(1, 5) ' 幅（セル数）
' ランダムな色を生成
randColor = RGB(WorksheetFunction.RandBetween(0, 255), _
WorksheetFunction.RandBetween(0, 255), _
WorksheetFunction.RandBetween(0, 255))
' 四角形を描画
For r = 0 To shapeHeight - 1
For c = 0 To shapeWidth - 1
If startRow + r <= maxRows And startCol + c <= maxCols Then
ws.Cells(startRow + r, startCol + c).Interior.Color = randColor
End If
Next c
Next r
Next i
MsgBox "貼り絵風アートが完成しました！"
End Sub
模様はランダムに描かれ、スクリプトを実行するたびに模様が変わります。色と形と配置が一応バランス取れているように感じます。これは私にはできません。
オブジェクトを貼り付けてイラストを描くVBAも作れるようですが、今回はエラーになり上手くいきませんでした。
ぜひチャレンジしてみてください。
ではまた。