|
|
Регистрация Восстановить пароль |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
|
Опции темы | Поиск в этой теме |
28.09.2011, 10:30 | #1 |
Пользователь
Регистрация: 22.09.2011
Сообщений: 20
|
Копирование всех открытых документов в один
Добры день!
Подскажите, пожалуйста, как в word макросом скопировать все открытые документы в один друг за другом? дело в том, что у меня при выборе позиций прайса в excel на каждой позиции есть вордовский документ с описанием, он открывается, если позициия выбрана, и нужно потом все описания позиций объеденить в один файл. |
28.09.2011, 21:42 | #2 |
Старожил
Регистрация: 31.12.2010
Сообщений: 2,133
|
Есть команда Вставка - Файл...
Может, лучше макросом в Excel открывать вордовские документы один за другим и сливать содержимое в один вордовский документ?
exceleved@yandex.ru Яндекс.Деньги: 410011500007619
|
19.01.2012, 19:44 | #3 |
Пользователь
Регистрация: 02.01.2012
Сообщений: 13
|
Копирование всех открытых документов в один
В продолжение темы....Как заполненые шаблоны(уже заявления)"складывать, один за одним,в один Вордовский ...длиннющий документ(фаил)?
|
19.01.2012, 21:01 | #4 |
Форумчанин
Регистрация: 17.11.2010
Сообщений: 222
|
Если в ручную, то в режиме Вид-->Структура-->Главный документ выполнить Вставить и выбрать нужный файл. Файлы в Главном документе будут храниться в виде гиперссылок. Чтобы посмотреть вложенный документ, достаточно выбрать Показать вложенные документы. Ну и специальный макрос можно написать, чтобы автоматизировать процесс
|
20.01.2012, 04:22 | #5 |
Особый статус
Участник клуба
Регистрация: 24.11.2008
Сообщений: 1,535
|
Перетаскивание мышью
Пока нет макроса и есть мышь — используйте перетягивание в новый документ Word.
Теория и история: http://ru.wikipedia.org/wiki/Drag-and-drop Ссылки на вложенные документы можно увидеть по Alt-F9 (это поля Embed).
Формула 1 (календарь чемпионата-2016): 26.11.2016 15:55 — Абу-Даби: http://ru.wikipedia.org/wiki/Гран-при_Абу-Даби — (квалификация)! Эфир: http://lion-tv.com/28-match-tv.html
Последний раз редактировалось Sasha_Smirnov; 20.01.2012 в 04:33. |
24.01.2012, 13:39 | #6 |
Пользователь
Регистрация: 02.01.2012
Сообщений: 13
|
Копирование всех открытых документов в один
Пробовал найти макрос обьединения документов Верд в один фаил ….нашел три …не работают (у меня).Нашел макрос обьединения листов Ехель (листы разных книг в один лист…красота…работает)Но программка ПЕРЕкачки из Ворд в Ехель…работает…но каждый раз перед закачкой очередного файла…спрашивает…где его взять(просит к нему ЕЕ провести)..хотя они все находятся в одной папке…все 20 шт…и все они doc файлы
(заполненные шаблоны…которые надо уложить в один документ…фаил) Как бы «упросить» этот макрос не задавать ,так много вопросов, а молча перекачать Все фаилы папки…в Ехель …(ведь есть папка…в ней подпапка ,в которой лежат 20 файлов с заполненными шаблонами, и рядом с этой ,подпапкой, находится книга Ехель …откуда и запускается программка ПЕРЕКАЧКИ…т.е.и фаилы кот перекачиваем и книга Ехель куда ОНИ укладываются и откуда СТАРТУЕТ программка перекачки … …находятся «под крышей»одной папки… ) Я понимаю спросила бы ПЕРВЫЙ раз....но каждый...ЗНАТОКИ...кто …что может предложить? Sub МакросПЕРЕкачки() Application.ScreenUpdating = False Dim WD As Object Dim ns As Worksheet Set WD = CreateObject("Word.Application") 'путь к файлу f = Application.GetOpenFilename("Файлы doc, \*. doc") If TypeName(f) = "Boolean" Then Exit Sub 'если Отмена - выход 'откроем выбранный файл Set wdd = WD.Documents.Open(f) 'выделяем содержимое документа wdd.Content.Select 'копируем содержимое документа t = wdd.Content.Copy 'создадим лист для этого документа в EXCEL Set ns = ActiveWorkbook.Worksheets.Add 'вставим скопированное в созданный лист ns.Paste Destination:=ns.Cells(1, 1) 'закрываем WORD wdd.Close (False) WD.Quit (False) End Sub |
24.01.2012, 20:19 | #7 |
Пользователь
Регистрация: 02.01.2012
Сообщений: 13
|
Копирование всех открытых документов в один
Массовое форматирование документов
Отсюда можно было бы использовать цикл…для автоматического забора файлов из папки..первый раз показал и потом на автомате..программа сама Sub batchFormating() 'массовое форматирование документов, находящихся в одной папке Dim myFile As String Dim myDoc As Document Dim path As String Dim fDlg As FileDialog Dim ext() As Variant Dim i As Long On Error Resume Next 'msoFileDialogFilePicker – позволяет пользователям выбрать один или более файлов. 'Пути к файлам, выбранным пользователям, сохраняются в коллекции элементов FileDialogSelectedItems Set fDlg = Application.FileDialog(msoFileDialo gFolderPicker) 'Выбираем папку с файлами для форматирования With fDlg .Title = "Выберите папку, содержащую документы и нажмите ДА" .AllowMultiSelect = False .InitialView = msoFileDialogViewList If .Show <> -1 Then MsgBox "Отменено", , "Массовое форматирование" Exit Sub End If path = fDlg.SelectedItems.Item(1) If Right(path, 1) <> "\" Then path = path + "\" End With 'Закрываем любые открытые документы If Documents.Count > 0 Then Documents.Close SaveChanges:=wdPromptToSaveChanges End If ext = Array("*.doc", "*.rtf") 'Заносим в массив типы расширений For i = 0 To UBound(ext) 'Запускаем цикл обхода файлов с расширениями из массива 'Заносим в переменную полный путь к первому файлу в папке, 'имена следующих файлов будут получены в цикле функцией Dir$() без аргументов myFile = Dir$(path & ext(i)) 'Запускаем цикл обработки каждого файла в папке While myFile <> "" 'Открываем каждый файл без видимости для пользователя Set myDoc = Documents.Open(path & myFile, Visible:=False) 'Изменяем форматирование каждого файла With myDoc With .Range With .PageSetup .LeftMargin = CentimetersToPoints(2) .RightMargin = CentimetersToPoints(1) .TopMargin = CentimetersToPoints(1) .BottomMargin = CentimetersToPoints(2) End With .Paragraphs.FirstLineIndent = CentimetersToPoints(1.25) .ParagraphFormat.LineSpacingRule = wdLineSpaceSingle With .Font .ColorIndex = wdBlack .Name = "Times New Roman" .Size = 12 End With End With .Close SaveChanges:=wdSaveChanges End With myFile = Dir$() 'получаем следующее имя файла из папки Wend Next i Set fDlg = Nothing Set myDoc = Nothing End Sub |
26.01.2012, 16:51 | #8 |
Пользователь
Регистрация: 02.01.2012
Сообщений: 13
|
Копирование всех открытых документов в один
Добился включения цикла…но не могу открыть эти файлы(кроме первого)..…НУЖНА СТРОКА КОДА
Этот ГИБРИД …сконструирован из вышеперечисленных…(вставляет выбранный документ но только ЕГО и столько раз сколько документов в папке…10 шт…10 раз вставит( т.е. на 10 листов Ехель книги)..не срабатывает одна СТРОКА(ее приходится закомментировать)VBA ругается…(выделяет желтым) и останавливает выполнение макроса… 'Открываем каждый файл без видимости для пользователя 'Set myDoc = Documents.Open(path & myFile, Visible:=False) Sub МакросПЕРЕкачки() Application.ScreenUpdating = False Dim WD As Object Dim ns As Worksheet Set WD = CreateObject("Word.Application") 'путь к файлу f = Application.GetOpenFilename("Файлы doc, \*. doc") If TypeName(f) = "Boolean" Then Exit Sub 'если Отмена - выход ext = Array("*.doc", "*.rtf") 'Заносим в массив типы расширений For i = 0 To UBound(ext) 'Запускаем цикл обхода файлов с расширениями из массива 'Заносим в переменную полный путь к первому файлу в папке, 'имена следующих файлов будут получены в цикле функцией Dir$() без аргументов myFile = Dir$(path & ext(i)) 'Запускаем цикл обработки каждого файла в папке While myFile <> "" 'Открываем каждый файл без видимости для пользователя 'Set myDoc = Documents.Open(path & myFile, Visible:=False) 'откроем выбранный файл Set wdd = WD.Documents.Open(f) 'выделяем содержимое документа wdd.Content.Select 'копируем содержимое документа t = wdd.Content.Copy 'создадим лист для этого документа в EXCEL Set ns = ActiveWorkbook.Worksheets.Add 'вставим скопированное в созданный лист ns.Paste Destination:=ns.Cells(1, 1) 'End With myFile = Dir$() 'получаем следующее имя файла из папки Wend Next i Set fDlg = Nothing Set myDoc = Nothing End Sub …кто ,что может подсказать… |
29.01.2012, 23:55 | #9 |
Пользователь
Регистрация: 02.01.2012
Сообщений: 13
|
Копирование всех открытых документов в один Ответить в теме
КОООООООООООООООООООООООООДДДДДДДДД ДДДД
Я его все таки сделал сам…. Перекачки док. Ворд из папки(все файлы которые есть) укладываются (каждый файл на отдельный лист)Ехелевской Книги…фаил-лист,фаил-лист…затем собираем все листики-файлы(другой программкой)…на отдельный лист (распологаются они вертикально…один за другим)но уже на одном листе…и так делаем перекачку Целой папки Вордовских документов –фалов…на один листик Ехеля…песня… Народ навались...разгребай... Sub МакросПЕРЕкачки200() Application.ScreenUpdating = False Dim Document Dim ns As Worksheet Set WD = CreateObject("Word.Application") 'путь к файлу f = Application.GetOpenFilename("Файлы doc, \*. doc") If TypeName(f) = "Boolean" Then Exit Sub 'если Отмена - выход 'Пути к файлам, выбранным пользователям, сохраняются в коллекции элементов FileDialogSelectedItems Set fDlg = Application.FileDialog(msoFileDialo gFolderPicker) With fDlg If .Show <> -1 Then Exit Sub End If path = fDlg.SelectedItems.Item(1) If Right(path, 1) <> "\" Then path = path + "\" End With ext = Array("*.doc") 'Заносим в массив типы расширений For i = 0 To UBound(ext) 'Запускаем цикл обхода файлов с расширениями из массива 'Заносим в переменную полный путь к первому файлу в папке, 'имена следующих файлов будут получены в цикле функцией Dir$() без аргументов myFile = Dir$(path & ext(i)) 'Запускаем цикл обработки каждого файла в папке While myFile <> "" 'Открываем каждый файл без видимости для пользователя Set myDoc = WD.Documents.Open(path & myFile, Visible:=False) 'Set myDoc = WD.Documents.Open(Dir$(path & ext(i))) 'выделяем содержимое документа myDoc.Content.Select 'копируем содержимое документа t = myDoc.Content.Copy 'создадим лист для этого документа в EXCEL Set ns = ActiveWorkbook.Worksheets.Add 'вставим скопированное в созданный лист ns.Paste Destination:=ns.Cells(1, 1) 'закрываем WORD myDoc.Close SaveChanges:=wdSaveChanges myFile = Dir$() 'получаем следующее имя файла из папки Wend Next i Set fDlg = Nothing Set myDoc = Nothing WD.Quit (False) End Sub |
30.01.2012, 03:42 | #10 |
Особый статус
Участник клуба
Регистрация: 24.11.2008
Сообщений: 1,535
|
Ура!
Код:
Формула 1 (календарь чемпионата-2016): 26.11.2016 15:55 — Абу-Даби: http://ru.wikipedia.org/wiki/Гран-при_Абу-Даби — (квалификация)! Эфир: http://lion-tv.com/28-match-tv.html
|
|
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
Список открытых документов Excel | Paul Hindenburg | Общие вопросы Delphi | 0 | 12.05.2011 10:40 |
Закрытие всех документов без сохранения | Окоча Юра | Microsoft Office Word | 7 | 30.11.2010 18:48 |
Обработка событий во всех открытых книгах | agregator | Microsoft Office Excel | 17 | 18.02.2010 13:11 |
список всех открытых файлов и папок. | Teleport | Общие вопросы Delphi | 4 | 22.06.2008 11:29 |