Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Word
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 28.09.2011, 10:30   #1
sersh1
Пользователь
 
Регистрация: 22.09.2011
Сообщений: 20
По умолчанию Копирование всех открытых документов в один

Добры день!
Подскажите, пожалуйста, как в word макросом скопировать все открытые документы в один друг за другом?
дело в том, что у меня при выборе позиций прайса в excel на каждой позиции есть вордовский документ с описанием, он открывается, если позициия выбрана, и нужно потом все описания позиций объеденить в один файл.
sersh1 вне форума Ответить с цитированием
Старый 28.09.2011, 21:42   #2
Казанский
Старожил
 
Аватар для Казанский
 
Регистрация: 31.12.2010
Сообщений: 2,133
По умолчанию

Есть команда Вставка - Файл...
Может, лучше макросом в Excel открывать вордовские документы один за другим и сливать содержимое в один вордовский документ?
exceleved@yandex.ru Яндекс.Деньги: 410011500007619
Казанский вне форума Ответить с цитированием
Старый 19.01.2012, 19:44   #3
maykkk
Пользователь
 
Регистрация: 02.01.2012
Сообщений: 13
По умолчанию Копирование всех открытых документов в один

В продолжение темы....Как заполненые шаблоны(уже заявления)"складывать, один за одним,в один Вордовский ...длиннющий документ(фаил)?
maykkk вне форума Ответить с цитированием
Старый 19.01.2012, 21:01   #4
Пименов Александр
Форумчанин
 
Регистрация: 17.11.2010
Сообщений: 222
По умолчанию

Цитата:
Сообщение от maykkk Посмотреть сообщение
В продолжение темы....Как заполненые шаблоны(уже заявления)"складывать, один за одним,в один Вордовский ...длиннющий документ(фаил)?
Если в ручную, то в режиме Вид-->Структура-->Главный документ выполнить Вставить и выбрать нужный файл. Файлы в Главном документе будут храниться в виде гиперссылок. Чтобы посмотреть вложенный документ, достаточно выбрать Показать вложенные документы. Ну и специальный макрос можно написать, чтобы автоматизировать процесс
Пименов Александр вне форума Ответить с цитированием
Старый 20.01.2012, 04:22   #5
Sasha_Smirnov
Особый статус
Участник клуба
 
Аватар для Sasha_Smirnov
 
Регистрация: 24.11.2008
Сообщений: 1,535
По умолчанию Перетаскивание мышью

Пока нет макроса и есть мышь — используйте перетягивание в новый документ Word.

Теория и история: http://ru.wikipedia.org/wiki/Drag-and-drop

Ссылки на вложенные документы можно увидеть по Alt-F9 (это поля Embed).
Изображения
Тип файла: jpg dragster.jpg (39.8 Кб, 138 просмотров)

Последний раз редактировалось Sasha_Smirnov; 20.01.2012 в 04:33.
Sasha_Smirnov вне форума Ответить с цитированием
Старый 24.01.2012, 13:39   #6
maykkk
Пользователь
 
Регистрация: 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
maykkk вне форума Ответить с цитированием
Старый 24.01.2012, 20:19   #7
maykkk
Пользователь
 
Регистрация: 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
maykkk вне форума Ответить с цитированием
Старый 26.01.2012, 16:51   #8
maykkk
Пользователь
 
Регистрация: 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
…кто ,что может подсказать…
maykkk вне форума Ответить с цитированием
Старый 29.01.2012, 23:55   #9
maykkk
Пользователь
 
Регистрация: 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
maykkk вне форума Ответить с цитированием
Старый 30.01.2012, 03:42   #10
Sasha_Smirnov
Особый статус
Участник клуба
 
Аватар для Sasha_Smirnov
 
Регистрация: 24.11.2008
Сообщений: 1,535
По умолчанию

Ура!
Код:
If Right(path, 1) <> "\" Then path = path + "\"
Из-за отсутствия этого "ухищрения" и могло не работать предыдущее.
Sasha_Smirnov вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Список открытых документов 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