[PMR]

Дюк спасибо!
Я хотел примерно следующее, там кстати есть вопросик.

Sub Смайлы()
'
' Макрос1 Макрос
'

Application.Browser.Previous
Dim aDoc As Document
Set aDoc = ActiveDocument

' Создаем два массива типа char: с исходным текстом и с текстом после обработки
' новый текст пока пустой
Dim r, txm
Set r = aDoc.Content
txm = ""
dlina = 15

'перебираем все символы исходного текста
For i = 1 To Len(r)

' k - позиция внутри куска с #...текст...#
k = 1

simvol = Mid(r, i, 1)
smiles = ""
' Eсли текущий символ #, ищем следующий знак #
If simvol = "#" Then
While Mid(r, i + k, 1) <> "#" 'символы внутри #...текст...#
smiles = smiles + Mid(r, i + k, 1)

If k > dlina Then ' Eсли # не закрыта второй # и меньше dlina, оставляем ее
txm = txm + smiles
i = i + k + 1
GoTo 10
End If
k = k + 1
Wend
k = k + 1 ' зачем?

' Tупо пропускаем все символы между ##, включая их самих
i = i + k - 1
Else

' Добавляем текущий символ в конец массива txm
10 txm = txm + Mid(r, i, 1)
End If
Next i

' Очищаем весь документ
aDoc.Content.Select
Selection.Delete

' Вписываем в него новое содежимое, накопленное в txm, закрываем файли сохраняем его.
aDoc.Content = txm
End Sub