Ищу примеры интересных и наглядных макросов - VBA

Формулировка задачи:

Ищу интересные наглядные макросы (или задания) для школьников, приблизительно на 5-6 академических часов неспешного решения. Пока самостоятельно придумал только рисование шахматной доски произвольного размера с обводкой ячеек по запросу пользователя (через msgbox). Что бы еще интересного можно предложить? Интересуют в первую очередь задания, решить постараюсь сам)

Решение задачи: «Ищу примеры интересных и наглядных макросов»

textual
                            Листинг программы 
                        

                            Option Explicit
Const cntQueens = 8 'Количество ферзей (или размер доски)
Dim H(1 To cntQueens) As Integer 'горизонталь для каждого ферзя
Dim chessMap As Range
Dim R As Long
 
Sub Queens()
'Erase H
Cells.Clear
Cells.Font.Size = 36
Cells.HorizontalAlignment = xlCenter
Cells.VerticalAlignment = xlCenter
Cells.RowHeight = 40
Cells.ColumnWidth = 6.86
Cells(1).Activate
R = 1
Решение 1
End Sub
 
Sub Решение(W As Integer)
Dim I As Integer
For H(W) = 1 To cntQueens
  For I = 1 To W - 1
    If H(I) = H(W) Or Abs(H(I) - H(W)) = W - I Then 'ферзи бьют друг друга
      Exit For 'идём вверх, на Next H(W)
    End If
  Next I
  If I = W Then 'ферзи не бьют друг друга
    If W = cntQueens Then 'ферзь последний
      Set chessMap = Range(Cells(R, 1), Cells(R + cntQueens - 1, cntQueens))
      With chessMap
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
      End With
      For I = 1 To cntQueens
         Cells(cntQueens - H(I) + R, I) = ChrW(9819)
      Next I
      R = R + cntQueens + 1
    Else 'ферзь не последний
      Решение W + 1 'идём к следующему
    End If
  End If
Next H(W)
End Sub
                        