Public Sub text_in_word()
Dim word_obj As Object ' не стоит забывать что так тоже можно обьявлять переменную.
Dim const_input_txt As String ' Это тот кусок текста, что нам надо перенести в ворд
Dim Full_name_new_doc As String 'ПОЛНОЕ имя нашего документа будет лежать здесь
Dim Name_new_doc As String 'имя нашего документа будет лежать здесь
Dim i As Integer 'пригодится, мало ли чего..... :)
Dim range_word As Word.Range 'а вот это стадия раннего связывания. . ' Ниже будет понятно зачем оно нам надо (не связывание а переменная) Dim range_character As Word.Range 'Ниже будет понятно зачем оно нам надо
Dim range_sentences As Word.Range 'Ниже будет понятно зачем оно нам надо
'' ----------стандартный модуль открытия объекта --------
Err.Clear 'очистка ошибок
On Error Resume Next
Set word_obj = GetObject(, "word.Application")'Проверили, вдруг ворд уже открыт
If Err = 429 Then ' ну коли закрыт - откроем
Set word_obj = CreateObject("word.Application") 'так или иначе, объект мы получили
ElseIf Err <> 0 Then
MsgBox "error" & Err ' если какая то еще ошибка - например пользователь не имеет доступа
End If ' к ворд - пишем какая ошибка
If Err <> 429 And Err <> 0 Then Exit Sub Else Err.Clear ' и выйдем, если ошиблись
On Error GoTo 0 ' при этом еще происходит очистка ошибки аналогично Err.Clear
'' ----------Ваяем далее --------
''-----------Проверка свободного файла -----------------
On Error Resume Next
If Dir("c:text_in.doc", vbNormal) <> "" Then Kill "c:text_in.doc" 'Этот файл будет шаблоном
'для последующего переноса данных. Если он уже есть тогда его удалим.
If Err = 75 Then
MsgBox "А кто то с этим файлом работает...." 'если файл занят другими пользователями
Exit Sub ' остановим процедуру
ElseIf Err <> 0 Then
MsgBox Err ' при условии что призошла ошибка файловой системы
Exit Sub ' тоже остановим процедуру
End If
On Error GoTo 0
''------------------- место для файла есть, объект создали --------
''----- Откроем новый файл, с шаблоном Normal ---------
With word_obj 'Что бы не писать далее много раз имя переменной.
'И работать будет немного быстрее
.Visible = True 'а то не видно, чего там происходит :)
.Documents.Add Template:="normal.dot", NewTemplate:=False, _
DocumentType:=wdNewBlankDocument, Visible:=True
' добавили ЧИСТЫЙ НОВЫЙ документ, шаблон у него будет normal, он станет активным при открытии
' и будет именно документом, а не шаблоном
Full_name_new_doc = .ActiveDocument.FullName ' получили ПОЛНОЕ имя нашего нового документа
Name_new_doc = .ActiveDocument.Name ' получили имя нашего нового документа
const_input_txt = "Уважаемые дамы и господа! Оповещаем Вас, что надо обработать " & _
"все нижеперечисленные заказы и развезти их по адресам:" & vbCrLf & " Заказ#234/исп " & _
vbCrLf & "тот кто не имеет аксесс к необходимым документам, тот будет отстранен до выяснения " & _
"причин присутствия наличия отсутствия!" 'Тут я использовал vbcrlf,как перенос строки, для получения
'более структурно различимого текста в документе. Но даже перенос можно было обработать програмно
' добавлением в слова перенос строки.
If .ActiveDocument.FullName <> Full_name_new_doc Then .Documents(Name_new_doc).Activate
If .ActiveDocument.Words.Count > 1 Then ' дело в том что в чистом документе есть 1 "слово"
'Это место вставки.
For i = .ActiveDocument.Words.Count To 2 Step -1 'Задом наперед для того что бы не возиться с
' do while - end
.ActiveDocument.Words(i).Delete 'убираем все слова поочередно, начиная с последнего
'я, конечно же, понимаю, что в НОВОМ документе нет ничего. Этот кусок нужен тем, кто работает
' с существующими документами.
Next
End If
.Selection.Text = const_input_txt ' Использовали объект selection для вставки текста.
'т.к. именно наш документ сейчас активен - то все нормально.Но все же я проверил какой документ активен.
'ввиду того, что никаких выделеных областей в новом документе нет, а есть только область вставки
'(палочка-курсор), то вставится именно в это место.
If .ActiveDocument.Words.Count > 10 Then 'Мы то знаем что слов вставили более 10 шт. Но мало ли чего.
.ActiveDocument.Words(10).Case = wdTitleWord 'Удобный метод range, по смене регистра
For Each range_word In .ActiveDocument.Words 'Поиск во всем диапазоне слов
If range_word.Text = "аксессc " Then range_word.Text = "Access " ' слово должно оканчиваться пробелом ' или знаком препинания или спец сиволом
Next
End If
Set range_sentences = .ActiveDocument.Range(Start:=.ActiveDocument.Sentences(1).Start, End:=.ActiveDocument.Sentences(3).End) ' сделали конецом диапазона третье предложение ' сделали началом диапазона первое предложение
range_sentences.Select
For Each range_character In range_sentences.Characters ' только для 3х предложений
If range_character.Text Like "@" Then range_character.Text = "№" ' like тоже можно использовать
Next ' последнее, это добавление новых элементов в коллекцию. ' много вариантов. Например использовать метод replace ' можно использовать метод find, а потом selection и вставить текст ' ну раз уж мы используем коллекции. У words нет явного метода add. Думаю это сделано для ' избежания неразберихи, при введении этого метода явно. ' а вот метод insertafter (before) как пить дать то что надо!
For Each range_word In .ActiveDocument.Words
If range_word.Text = "господа" Then range_word.InsertAfter ", а также дяденьки и тетеньки"
Next ' ну вроде все что обещался - сделал. Причем только методы ворд использовал.
Full_name_new_doc = "c:text_in.doc" 'Задали имя для записи документа
.ActiveDocument.saveas filename:=Full_name_new_doc, fileformat:=wdFormatDocument 'вообще 'SaveAs имеет много параметров, так что я часть их просто не использовал
.ActiveDocument.Close 'Закрыл именно этот документ
If .Documents.Count = 0 Then .Application.Quit SaveChanges:=wdDoNotSaveChanges 'А вот тут как раз проверили, если нет более документов - можем вообще закрыть приложение.
End With
Set word_obj = Nothing 'очистили память
End Sub
|