« プライバシーシート2 | トップページ | 2度目のエラーは捕えない »

2011年7月31日 (日)

虫食い

今回もプライバシーシートと同様に
乱数を使ってセルの塗りつぶしを設定していきます。

虫食いとは何?ということですが、
いちばん最初にあるセルを選択しているとします。
次に
そこから上、下、右、左のセルのどれかに
移動します。
この4つの方向を決めるのに乱数を使います。
あとはそれの繰り返しです。

1行目のどこかのセルでさらに上に進もうとすると
エラーになります。
このような状況のエラーを防ぐために、
上端と下端の行、左端と右端の列ではないかの
判定をIf文でしています。

コードはこちら

ランダムな白黒模様を作成するコード:

Sub macro110731a()
'虫食い

    Sheets.Add
   
    Dim i As Long
    Dim MyRange As Range
    Dim r As Range
    Set r = Selection
   
    'セルの大きさ変更
    Cells.RowHeight = 3
    Cells.ColumnWidth = 2 * (6.88 / 45)
   
    For i = 0 To 200000
        r.Select
        Select Case Int(Rnd * 4)
            Case 0
                If r.Row + 1 < Rows.Count Then
                    r.Offset(1, 0).Interior.ColorIndex = 1
                    Set r = r.Offset(1, 0)
                End If
            Case 1
                If r.Column + 1 < Columns.Count Then
                    r.Offset(0, 1).Interior.ColorIndex = 1
                    Set r = r.Offset(0, 1)
                End If
            Case 2
                If r.Row - 1 > 0 Then
                    r.Offset(-1, 0).Interior.ColorIndex = 1
                    Set r = r.Offset(-1, 0)
                End If
            Case 3
                If r.Column - 1 > 0 Then
                    r.Offset(0, -1).Interior.ColorIndex = 1
                    Set r = r.Offset(0, -1)
                End If
        End Select
    Next i
   
End Sub

実行後のシートの一例:
Vba20110731a

これはシートを25%で表示した画像です。

こういうのも何回やっても
飽きないです。

|

« プライバシーシート2 | トップページ | 2度目のエラーは捕えない »

コメント

この記事へのコメントは終了しました。

トラックバック


この記事へのトラックバック一覧です: 虫食い:

« プライバシーシート2 | トップページ | 2度目のエラーは捕えない »