24.06.2014, 23:11
|
Re: Как удалить подстроки в txt или word файле
#5
|
Администратор
Детали профиля (+/-)
Ответов: 42,155
Регистрация: 12.05.2008
Адрес: Тирасполь
Спасибо:4,667/4,985
Не понравилось:136/372
Репутация:
|
Дюк спасибо!
Я хотел примерно следующее, там кстати есть вопросик.
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
|
________________
Судьба - совокупность совершенных глупостей человека. Любите и принимайте людей такими, какие они есть.
Если Вас оскорбили - нажимаем "Пожаловаться на это сообщение" слева от поста под аватаром хама.
|
|
|