Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Управление Word макросом из Excel
 
#1
21.12.2009 20:05:52
вобщем, в кратце: надо нажатием кнопки на странице Excel макросом вписать в ОТКРЫТЫЙ вордовский документ номер протокола и дату регистрации (NOW ),зафиксировать его в списке ,  сохранить в определённую папку так, чтобы его можно было открыть из этой же книги Excel  
 
подробнее:  
открываем Единый реестр протоколов ЭТЛ.xls  
открываем Cопротивление изоляции.doc (это может быть любой текстовый файл с любым названием, но в нем есть строки ПРОТОКОЛ,ОБЪЕКТ,ЗАКАЗЧИК и "   "___________20  г.)  
нажимаем КНОПКУ "ЗАРЕГИСТРИРОВАТЬ ПРОТОКОЛ"  
макрос Excel считывает название (уже !) открытого вордовского документа, копирует его в столбец "название бланка протокола",и  соответсвенно строки ОБЪЕКТ,ЗАКАЗЧИК.  
таблица формирует дату регистрации, новое название документа, путь к новому файлу в папке "ГОТОВЫЕ ПРОТОКОЛЫ" и гиперссылку на него.  
далее макрос Excel берёт из нового названия протокола строку вида "№_ЭР_ГОД" ( напр. 345_ЭР_2009) и заменяет в ворде строку ПРОТОКОЛ строкой ПРОТОКОЛ 345_ЭР_2009 и дату ("   "___________20  г.) аналогично.  
макрос Excel сохраняет изменённый файл в папку ГОТОВЫЕ ПРОТОКОЛЫ с атрибутом только для чтения.  
при добавлении нового файла все записи должны вестись в следующих строках таблицы.  
 
зы образец вордрвского протокола (который необходимо зарегистрировать) приложен- сопротивление изоляции.doc  
 
пробовал конструкцию вида:  
Application.ActivateMicrosoftApp xlMicrosoftWord  
- открывает НОВЫЙ документ, а мне нужно прицепиться к уже открытому (он единственный на компе будет открытым).  
дальше в ворде макрорекордер и копипастить в макрос Excel-ето вроде ясно  
 
SendKeys -тоже пробовал, но как только переключаюсь в окно ворда (%  
{TAB}) -работа макроса закнчивается  
 
ПАМАГИТЕ! немогу создать обьект из открытого вордовского документа (название его заранее не известно, кроме ".doc") для нормальной работы макроса
 
 
 
#2
22.12.2009 16:24:02
Посмотрел я Вашу работу. Если Вам с документлв Word нужны отдельные строки, то можно использовать следующую схему: Из открытого документа Word копируете весь лист на вновь открытую книгу. И уже с этой книги методом Find находите нужные строки. Передавать управление приложению Word в таком случае не надо и все получится. Выложу пример готовой работы, как работает разбирайтесь - будут вопросы пишите. В прилагаемом файле листинг процедуры. Фильтровать и делать из нее пример не стал. Посмотрите принцип и ваяйте под свою задачу. Все, что находится выше строки помеченной желтым - можете вставлять к себе без купюр - заработает как надо - то, что ниже - надо поработать... <BR><STRONG>Файл удален</STRONG> - велик размер. [Модераторы]
 
 
 
#3
22.12.2009 17:19:12
огромное спасибо за внимание к моей проблеме. изучаю вашу программу, кстати вот нарыл: http://www.planetaexcel.ru/forum.php?thread_id=4312  применительно ко мне это выглядит примерно вот так: <BR><STRONG>Файл удален</STRONG> - велик размер. [Модераторы]
 
 
 
#4
22.12.2009 20:11:50
Дмитрий, Юрий файлик весил 57Кб за что ж Вы его так...
 
 
 
#5
22.12.2009 20:18:54
Влад, я его удалял. Точно не помню, но около 130К. Перепроверьте. Или Вы ошибочно прикрепили другой.
 
 
 
#6
22.12.2009 20:43:53
Ну и бог с ним. Листинг был строк на 80 - хотел как лучше... Если автор пожелает выложу повторно.
 
 
 
#7
23.12.2009 12:54:31
ваш листинг я изучаю пока, а предыдущий мой черновик вот:  
Sub ETW()  
 
Dim SaveAsName As String  
'On Error GoTo ErrorHandler  
Set Ворд = GetObject(, "Word.Application")  
SaveAsName = ThisWorkbook.Path & "\ГОТОВЫЕ ПРОТОКОЛЫ\" & Range("H6") & ".doc"  
'Ищем в ворде текст ПРОТОКОЛ и заменяем номером протокола  
With Ворд  
With Ворд.Selection.Find  
.Text = "ПРОТОКОЛ №"  
.Replacement.Text = "ПРОТОКОЛ № " & Range("H6")  
.Wrap = 1  
.Execute Replace:=2  
End With  
' Сохранение документа  
.ActiveDocument.SaveAs Filename:=SaveAsName  
End With  
MsgBox " Открытый протокол зарегистрирован и сохранён в папке " & ThisWorkbook.Path & "\ГОТОВЫЕ ПРОТОКОЛЫ" & " под именем " & Range("H6") & ".doc"  
'Exit Sub  
'ErrorHandler:  
'MsgBox "Нет открытого протокола-откройте протокол и нажмите кнопку ещё раз"  
   'Resume Next  
End Sub  
 
 
извиняюсь, файлик мой весит уже 1,8Мб, ограничение я так понял 100Кб?
 
 
 
#8
23.12.2009 18:59:45
ЗЫ чтобы не было непоняток: ваш вордовский листинг я успел всё-таки слизнуть и сохранить. Кое- какие блоки из него наверное использую...  
Готовую работу торжественно клянусь выложить с грифом "Методы неправильного подхода к программированию" %)  - я, мягко говоря ,такой же балерун как и программист ).
 
 
 
#9
29.12.2009 23:40:02
Вот, накропал:  
 
 
Sub ETW()  
 
Dim SaveAsName As String  
 
'On Error GoTo ErrorHandler  
Set Ворд = GetObject(, "Word.Application")  
 
'переход на следующую пустую строку  
   строка = Range("B3") + 14  
 
With Ворд  
   бланк = .ActiveWindow.Caption  
End With  
     
   Cells(строка, 2).Value = бланк  
SaveAsName = ThisWorkbook.Path & "\ГОТОВЫЕ ПРОТОКОЛЫ\" & Range("H" & строка) & ".doc"  
 
'Копируем заказчика  
Ворд.Selection.WholeStory  
 
'Ворд.Selection.MoveLeft Unit:=wdCharacter, Count:=1  
Ворд.Selection.Find.ClearFormatting  
With Ворд  
   With Ворд.Selection.Find  
       .Text = "заказчик:"  
       .Replacement.Text = ""  
       .Forward = True  
       .Wrap = wdFindContinue  
       .Format = False  
       .MatchCase = False  
       .MatchWholeWord = False  
       .MatchWildcards = False  
       .MatchSoundsLike = False  
       .MatchAllWordForms = False  
   End With  
End With  
Ворд.Selection.Find.Execute  
'Ворд.Selection.MoveRight Unit:=wdCharacter, Count:=1  
'Ворд.Selection.EndKey Unit:=wdLine, Extend:=wdExtend  
Ворд.Selection.Copy  
 
ActiveSheet.Paste Destination:=Worksheets("Лист1").Range("C" & строка)  
 
 
'Копируем объект  
Ворд.Selection.WholeStory  
 
'Ворд.Selection.MoveLeft Unit:=wdCharacter, Count:=1  
Ворд.Selection.Find.ClearFormatting  
With Ворд  
   With Ворд.Selection.Find  
       .Text = "заказчик:"  
       .Replacement.Text = ""  
       .Forward = True  
       .Wrap = wdFindContinue  
       .Format = False  
       .MatchCase = False  
       .MatchWholeWord = False  
       .MatchWildcards = False  
       .MatchSoundsLike = False  
       .MatchAllWordForms = False  
   End With  
End With  
Ворд.Selection.Find.Execute  
'Ворд.Selection.MoveRight Unit:=wdCharacter, Count:=1  
'Ворд.Selection.EndKey Unit:=wdLine, Extend:=wdExtend  
Ворд.Selection.Copy  
 
ActiveSheet.Paste Destination:=Worksheets("Лист1").Range("D" & строка)  
 
'Ищем в ворде текст ПРОТОКОЛ и заменяем номером протокола  
With Ворд  
   With Ворд.Selection.Find  
   .Text = "ПРОТОКОЛ №"  
   .Replacement.Text = "ПРОТОКОЛ № " & Range("K" & строка)  
   .Wrap = 1  
   .Execute Replace:=2  
   End With  
' Сохранение документа  
.ActiveDocument.SaveAs Filename:=SaveAsName  
End With  
 
MsgBox " Открытый протокол зарегистрирован и сохранён в папке " & ThisWorkbook.Path & "\ГОТОВЫЕ ПРОТОКОЛЫ" & " под именем " & Range("H" & строка) & ".doc"  
 
Exit Sub  
 
ErrorHandler:  
MsgBox "Нет открытого протокола-откройте протокол и нажмите кнопку ещё раз"  
End Sub  
 
 
трабла в подобных строках:  
Ворд.Selection.MoveLeft Unit:=wdCharacter, Count:=1  
Ворд.Selection.MoveRight Unit:=wdCharacter, Count:=1  
Ворд.Selection.EndKey Unit:=wdLine, Extend:=wdExtend  
 
-это куски вордовского макроса (выдрал макрорекордером), перемещение курсором по тексту для выделения нужного куска строки.    
Так вот,екселевский дебагер находит в них ошибку, типа объект не может быть применён или типа того.    
Ето действительно так, те ексель непереваривает такие (чисто вордовские) команды или я просто орфографию не соблюл?
 
 
 
#10
27.04.2010 08:17:52
{quote}{login=3aropyuko}{date=29.12.2009 11:40}{thema=}{post}  
Ворд.Selection.MoveLeft Unit:=wdCharacter, Count:=1  
Ворд.Selection.MoveRight Unit:=wdCharacter, Count:=1  
Ворд.Selection.EndKey Unit:=wdLine, Extend:=wdExtend  
{/post}{/quote}  
 
Сейчас разбираюсь с подобной проблемой. В экселе видите-ли нет констант типа wdCharacter, wdLine - удалите то что связано с Unit и, скорее всего, wdExtend тоже нет. Вам проще: wdCharacter и wdLine и так поумолчанию - уберете Unit:=wdLine - перейдет, а вот как мне перейти вправо на несколько слов (wdWord) пока вопрос...
 
 
 
#11
27.04.2010 08:28:00
// Добавка:  
wdCharacter=1  
wdLine=1  
wdWord=2  
Просто ставим значения раз константы не определены  
wdExtend попробуйте просто убрать - не поможет - ищите чему равно  
Не совсем хороший подход вбивать числами, но микрософт пока вроде не меняла константы, так что работать будет.  
Удачи!
 
 
 
Страницы: 1
Читают тему
Наверх