Перемещение абзацев внутри ячейки

[piatka]

В Word таблица из двух столбцов - тест. Во втором столбце в каждой ячейке варианты ответов, каждый вариант в отдельном абзаце (количество вариантов различное в разных вопросах). Необходимо перемешать абзацы (варианты) внутри каждой ячейки, т.к. правильные варианты указаны на вершине списка. Вопросов 2500.
Помогите, пожалуйста, советом.

[viter.alex]

1. Абзацы в ячейке, содержащей ответы, загнать в массив
2. Содержимое ячейки с ответами удалить
3. Генерировать случайное число от 0 до количества элементов в массиве (т.е. количества вариантов), исключая повторение
4. Добавлять абзацы из массива в ячейку, удаляя их при этом из массива.

Добавлено позже
Оказалось всё не так сложно. Потребовалось всего 15 минут.

Sub MixAnswers()
  Dim arAnswers() As String 'абзацы с ответами
  Dim oTbl As Table 'таблица с тестом
  Dim oCell As Cell 'ячейка с ответами
  Dim n As Integer 'счётчик ответов
  
  Set oTbl = Selection.Tables(1) 'Таблица в которой находится курсор
  Set oCell = oTbl.Cell(1, 2) 'Первая ячейка второго столбца
  
  Do Until oCell Is Nothing 'Делать, пока не выйдем из таблицы
    'Ответы из абзацев в массив
    arAnswers = Split(Left(oCell.Range.Text, Len(oCell.Range.Text) - 2), vbCr)
    oCell.Range.Delete 'Удаление содержимого ячейки
    Do
      'Генерация случайного номера абзаца в заданных пределах
      Do
        n = GenRndNumber(0, UBound(arAnswers))
      Loop Until arAnswers(n) <> ""
      'Вставляем в ячейку вариант ответа
      oCell.Range.InsertAfter arAnswers(n)
      oCell.Range.InsertParagraphAfter
      arAnswers(n) = "" 'Очищаем данный вариант ответа, чтобы он не повторялся
    Loop While Join(arAnswers, "") <> "" 'Делать, пока в массиве есть непустые строки
    If oCell.RowIndex + 1 <= oTbl.Rows.Count Then
      Set oCell = oTbl.Cell(oCell.RowIndex + 1, 2) 'Следующая ячейка
    Else
      Set oCell = Nothing
    End If
    DoEvents 'Не зависать!
  Loop
End Sub

'Функция для генерации случайного целого числа в заданных пределах
Function GenRndNumber(Lower%, Upper%) As Integer
  Randomize
  GenRndNumber = Int((Upper% - Lower% + 1) * Rnd + Lower%)
End Function

[piatka]

Гениально. Спасибо огромное, буду пробовать!

[piatka]

Все получилось, без запинки! Не знаю, как благодарить!

[piatka]

Alex, можно вопрос?
Не поняла почему -2:
arAnswers = Split(Left(oCell.Range.Text, Len(oCell.Range.Text) - 2), vbCr)

[viter.alex]

Потому, что текст в ячейке таблицы всегда заканчивается двумя символами: абзаца (Chr(13)) и конца ячейки (Chr(7))

[piatka]

Смутно догадывалась.., восхищаюсь - знать такие тонкости!!!