Здравствуйте, эксперты.

Может ли кто-то помочь написать или может у кого-то уже есть готовая программа, чтобы в тексте в каждом слове оставлять только первую букву, заменяя все остальные точками.

Вот так:
М.... л. к..... п..... н....... и.. м.... у к...... у.. е... г...... п........

Количество точек соответствует количеству удаляемых букв.
Я пытался написать сам на VBA, но у меня выдает ошибку Invalid Procedure Call or Argument на строчке "d(j) = f & String$(e - 1, ".")", причем выполняется код какое-то время, а потом выдается ошибка. В отладчике видно, что переменная konez не пустая.

Приложение:
Sub Макрос6()
Dim c() As String
Dim d() As String
'Dim Probely() As Byte
Dim e As Long

Dim i As Long
Dim j As Long

'Выделяем текст
Selection.WholeStory
' Selection.MoveRight Unit:=wdCharacter, Count:=1
a = Selection.Text

'Узнаем сколько абзацев в тексте
b = CountDelimeter(a, vbCrLf)

ReDim c(1 To b) As String
' ReDim Probely(1 To b) As Byte

'Распределяем абзацы по элементам массива c(i)
For i = 1 To b
c(i) = GetSubString(a, vbCr, i)
Next i

'Находим слова в каждом абзаце и распределяем по элементам массива d(j)
For i = 1 To b
Probely = CountDelimeter(c(i), " ") + 1

ReDim d(1 To Probely) As String

For j = 1 To Probely
d(j) = GetSubString(c(i), " ", j)

'Замена всех букв в слове на точки, кроме первой
If (d(j) <> "-") Then
e = Len(d(j))
f = Left(d(j), 1)
d(j) = f & String$(e - 1, ".")
End If
konez = konez & d(j) & " "
Next j
konez = konez & vbCrLf
Next i
Debug.Print konez

End Sub