При слиянии в word из excel сохранить в отдельный файл с названиями по определенному полю

@Ируся · Регистрация: 24.07.2015

Author24 — интернет-сервис помощи студентам

Добрый день!
Есть файл word подготовленный по методу слияния и состоящий из 2000 страниц. Или сделать сразу из файла слияния такое сохранение.
Нужно сохранить каждую станицу в отдельный файл каждый под своим именем (наименование организации) которое состоит в вверху страницы и может содержать буквы и/или цифры и/или кавычки.
Помогите, пожалуйста, с макросом.
Спасибо.

shanemac51 · 02.05.2022, 12:54

Сообщение от Smailm

Супер! Какой из двух скриптов лучше применить в моей ситуации?

я бы предпочла другой формат таблицы, для слияния он не подходит, а для заполнения шаблона - очень удобен

Имя файла	DMC_Act of Acceptance of the Work_Ivanov_Ivan 05.2022	DMC_ Акт приемки работы_ivanov_ivan 05.2022
ФИО RUS	Иванов Иван	Ivanov Ivan
ИП/физик RUS	гражданин Российской Федерации	citizen of Russian Federation
Компания RUS	Что-то там Корп.	4-to-to tam Corp.
Президент RUS	Крутой директор	Krutoi Director

Дата RUS	15 апреля 2022	April 15, 2022

Номер и дата договора RUS	DMC-EM/01-10-20 от «01» октября 2020	DMC-EM/01-10-20 dated October 01, 2020
Период RUS	15 марта 2022 по 15 апреля 2022	March 15, 2022 to April 15, 2022
Сумма RUS	0000 (ноль тысяч) долларов США	Zero thousand ($0000) USD

Обязанности RUS	1.1. Мониторинг новых технологий;	1.1. Monitoring of new technologies;
	1.2. Анализ новых технологий и описание их плюсов и минусов для решения возникших задач;	1.2. Analysis of new technologies and a description of their advantages and disadvantages for solving any problems;
	1.3. Апробация новых технологий и выработка механизмов их использования для решения поставленных задач;	1.3. Testing of new technologies and the development of their use of the mechanisms for the task;
	1.4. Разработка программной архитектуры;	1.4. Development of software architecture;

@Smailm · 02.05.2022, 13:10

Punkt5, огромное спасибо за ваш ответ!

Все работает!
Единственное только после слияния, текст обязанностей выглядит одной строкой, т.е. не учитывается перенос строки.

@Punkt5 · 02.05.2022, 15:23

Сообщение от Smailm

Единственное только после слияния, текст обязанностей выглядит одной строкой, т.е. не учитывается перенос строки.

Естественно. Мы же используем стандартный функционал msWord: SearchAndReplace. А в нём для перевода строки предусмотрено использование специальных сочетаний символов: ^p и ^l. Поэтому, если есть необходимость использовать в замене набор из нескольких строк, надо эти разделители строк заменить на соответствующие спецсимволы.
Для этого в последнем коде между 54 и 55 строкой вставьте:

Visual Basic

55
56

          xStr=Replace(xStr,vbCRLF,"^p")
          xStr=Replace(xStr,vbLF,"^l")

@Smailm · 02.05.2022, 18:22

Punkt5, спасибо, перенос строк работает на ура!
А можно в скрипт добавить возможность созданные файлы в Word автоматически конвертировать в pdf (т.е. чтобы оставались вордовские файлы и рядом лежали pdf файлы)?

Сообщение от shanemac51

я бы предпочла другой формат таблицы, для слияния он не подходит, а для заполнения шаблона - очень удобен

Да, тут нужно слияние, поэтому такой вариант не подходит.

Сообщение от shanemac51

предпочитаю иное описание замен, конечно столбцы описываю по-порядку

Visual Basic

dim nc as long
dim aWhatFind(0 to 99) as String  ''с запасом + небольшое изменение в блоке замены
nc= 1         :aWhatFind(nc) = "Имя файла"
nc= 12        :aWhatFind(nc) = "@Дата ENG"
nc= 13        :aWhatFind(nc) = "@Дата RUS"
nc= 7         :aWhatFind(nc) = "«Компания_ENG»"
nc= 6         :aWhatFind(nc) = "«Компания_RUS»"
nc= 8         :aWhatFind(nc) = "«Президент_ENG»"
nc= 9         :aWhatFind(nc) = "«Президент_RUS»"
nc= 5         :aWhatFind(nc) = "«ИПфизик_ENG»"
nc= 4         :aWhatFind(nc) = "«ИПфизик_RUS»"
nc= 2         :aWhatFind(nc) = "«ФИО_ENG»"
nc= 3         :aWhatFind(nc) = "«ФИО_RUS»"
nc= 14        :aWhatFind(nc) = "«Номер_и_дата_договора_ENG»"
nc= 15        :aWhatFind(nc) = "«Номер_и_дата_договора_RUS»"
nc= 11        :aWhatFind(nc) = "«Обязанности_ENG»"
nc= 10        :aWhatFind(nc) = "«Обязанности_RUS»"
nc= 16        :aWhatFind(nc) = "«Период_ENG»"
nc= 17        :aWhatFind(nc) = "«Период_RUS»"
nc= 18        :aWhatFind(nc) = "«Сумма_ENG»"
nc= 19        :aWhatFind(nc) = "«Сумма_RUS»"

Попытался вставить вашу часть кода, но скрипт перестал работать наверное я его неправильно включил в скрипт.
Подскажите, пожалуйста, как его надо корректно туда добавить?

Visual Basic

dim xls, wrd, FSO, Sha, xDir, wDir, sDir, xF, sFiles, xFiles, aa, aWhatFind, aColNums, wStr, xStr
  Const hdrRows=2 'Число строк заголовков, которые пропускать
  aWhatFind=Array("Имя файла","@Дата ENG","@Дата RUS","«Компания_ENG»","«Компания_RUS»","«Президент_ENG»","«Президент_RUS»","«ИПфизик_ENG»","«ИПфизик_RUS»","«ФИО_ENG»","«ФИО_RUS»","«Номер_и_дата_договора_ENG»","«Номер_и_дата_договора_RUS»","«Обязанности_ENG»","«Обязанности_RUS»","«Период_ENG»","«Период_RUS»","«Сумма_ENG»","«Сумма_RUS»") 'массив того, что искать в word-шаблоне
  aColNums =Array(1,12,13,7,6,8,9,5,4,2,3,14,15,11,10,16,17,18,19) 'массив номеров колонок Escel-файла для замены
  Set FSO = CreateObject("Scripting.FileSystemObject") 
  
  xDir = FSO.GetAbsolutePathname("") ' xlsx ищем в текущей папке
  sDir = xDir 'папка, где лежат шаблоны, пока пишем текущую папку 
  wDir = xDir 'папка, куда кладём готовый результат. пока в текущую
  with  CreateObject("Shell.Application")
    Set sFiles = .NameSpace(sDir).Items() 'всё что есть в папке шаблонов
    Set xFiles = .NameSpace(xDir).Items() 'пока то же
  end with
  sFiles.Filter 64, "*.dotx" 'смотрим в папке шаблонов на файлы с такой маской.
  if sFiles.Count < 1 Then 'ФАЙЛОВ НЕТ
    wsh.echo "Нет шаблонов В папке " & wDir
    wsh.quit
  end if
  xFiles.Filter 64, "*.xlsx" 'смотрим в папке xlsx только на файлы с такой маской.
  if xFiles.Count < 1 Then 'ФАЙЛОВ НЕТ
    wsh.echo "Нет файлов *.xlsx В папке " & xDir
    wsh.quit
  end if
 
  Set xls = CreateObject("Excel.Application")
  xls.Visible = True 'лучше потом поменять на false, чтобы Excel открывался невидимым
  Set wrd = CreateObject("Word.Application")
  wrd.Visible = True 'лучше потом поменять на false, чтобы Word  открывался невидимым
 
  for each xF in xFiles 'переберём все xlsx файлы
    With xls.WorkBooks.Open(xf.Path)
      aa = .Sheets(1).UsedRange.Value
      .Close
    end with
    for iRow = HdrRows+1 to uBound(aa) step 1
      xlRow2Wrd() ' обработаем каждую строку
    next
  next
  xls.quit 'закроем Excel
  wrd.quit 'закроем Word
  Set wrd=Nothing: Set xls=Nothing: Set FSO=Nothing: Set Sha=Nothing
  Set sFiles=Nothing: Set xFiles=Nothing: Set xF=Nothing 'очистим объекты
  wsh.echo "Я кончила! Твоя очередь." 
  wsh.quit
  
  Sub xlRow2Wrd()
  dim fName
  const Repl=""".,&@#№'<>"
  for each sF in sFiles
    with wrd.documents.Open(sF.Path)
      for ii = 0 to uBound(aColNums) step 1
        if aColNums(ii) <= uBound(aa,2) then
          wStr = aWhatFind(ii) 'то_что_ищем в word-шаблоне  = заведомо маленькое и заведомо НЕ ПОПАДАЮЩЕЕСЯ в том_на_что_меняем
          xStr = aa(iRow,aColNums(ii)) 'то_на_что_меняем (из excel-таблицы). Может быть велико
                    xStr=Replace(xStr,vbCRLF,"^p")
          xStr=Replace(xStr,vbLF,"^l")
          do While Len(xStr) > 250 'до тех пор пока то_на_что_меняем > 250 символов
            'меняем в цикле то_что_ищем на обрезок того_на_что_меняем + то_что_ищем на хвосте
            .Content.Find.Execute wStr, False, False, False, False, False, True, 1, False, left(xStr,250-len(wStr)) & wStr, 2 
            xStr = mid(xStr,251-len(wStr)) 'отрезаем то, что уже вставили от начала того_на_что_меняем
          loop
          .Content.Find.Execute wStr, False, False, False, False, False, True, 1, False, xStr, 2 'довставляем остаток
        end if
      next
      fName = aa(iRow,aColNums(0))
      for ii=1 to Len(Repl) step 1
        fName = replace(fName,Mid(repl,ii,1),"")
      next
      .SaveAs FSO.BuildPath (wDir, fName),12 
      .Close
    end with
  next
end sub

@Punkt5 · 02.05.2022, 18:54

Сообщение от Smailm

ь созданные файлы в Word автоматически конвертировать в pdf (т.е. чтобы оставались вордовские файлы и рядом лежали pdf файлы)

Вот эта строчка сохраняет в word-файл с расширением .docx

Visual Basic

69	.SaveAs FSO.BuildPath (wDir, fName),12

Здесь 12 = .docx - это код типа сохраняемого документа. А 17 = .pdf
То есть для сохранения вместо .docx в .pdf надо в этой строке 12 поменять на 17.
А если надо и в .docx и в .pdf - надо продублировать рядом оба варианта:

Visual Basic

69
70

    .SaveAs FSO.BuildPath (wDir, fName),12
    .SaveAs FSO.BuildPath (wDir, fName),17

@Smailm · 02.05.2022, 20:52

Punkt5, все работает, благодарю

Добавлено через 1 час 2 минуты
Punkt5, подскажите, что нужно скорректировать в скрипте, чтобы наименование файла формировалось не только по данным из первой колонки?
Нужно, чтобы наименование файла бралось одновременно из двух колонок: 1 и 12.
Тут логика наименования файла такая, колонка 1 всегда статическая запись, а колонка 12 это дата, которая задается в ручную.

@Punkt5 · 02.05.2022, 21:19

Сообщение от Smailm

что нужно скорректировать в скрипте, чтобы наименование файла бралось одновременно из двух колонок: 1 и 12

Вроде постарался прозрачно и переменную fName назвать и в коде понятно, что имя в которое файл сохраняется через SaveAs берётся из переменной fName. Значит надо в переменную fName в 65 строке записать то, что нужно. Единственное, не забыть заменить точки в дате на тире, которые более подходят для наименования файла:

Visual Basic

65	fName = aa(iRow,1) & "_" & Replace(Cstr(aa(iRow,12)),".","-")

shanemac51 · 04.05.2022, 08:53

Сообщение от Smailm

Попытался вставить вашу часть кода, но скрипт перестал работать наверное я его неправильно включил в скрипт.
Подскажите, пожалуйста, как его надо корректно туда добавить?

я не люблю работать с внешними скриптами - предпочитаю код запускать из екселя, в котором возможны варианты
- запуск кода для конкретной строки
- для нескольких строк, например помеченных галочкой
- для отфильтрованных(например по дате или городу или ....)
- для всех - это крайний случай, чаще требуется формирование для выборки
....

причем ексель позволяет проводить фильтрацию/ поиск по любому из ваших 20 столбцов с предварительным просмотром выборки

Добавлено через 3 минуты

Сообщение от Ируся

Есть файл word подготовленный по методу слияния и состоящий из 2000 страниц

все таки, что вам требуется
- есть 2000 страниц ворда, надо получить 2000 документов ворда
- есть 2000 строк в екселе, надо получить те же 2000 документов ворда

я бы видимо предпочла иметь 2000 листов в екселе(лист для акта) , которые для печати программно переводила бы в ворд,
причем код не зависел бы от каталога размещения и мог запускаться из любого ексель-файла с данной структурой размещения информации

вашу схему (строка=акт) всегда можно получить программо, если потребуется для каких-то справок

@-SRG- · 03.03.2023, 16:33

Сообщение от Punkt5

Вот эта строчка сохраняет в word-файл с расширением .docx

Visual Basic

69	.SaveAs FSO.BuildPath (wDir, fName),12

Здесь 12 = .docx - это код типа сохраняемого документа. А 17 = .pdf
То есть для сохранения вместо .docx в .pdf надо в этой строке 12 поменять на 17.
А если надо и в .docx и в .pdf - надо продублировать рядом оба варианта:

Visual Basic

69
70

    .SaveAs FSO.BuildPath (wDir, fName),12
    .SaveAs FSO.BuildPath (wDir, fName),17

Использовал предоставленное вами решение - с сохранением в ворд все работает отлично. Очень выручили! Спасибо!

Есть нюанс... Когда меняю "12" на "17", то все сгенерированные файлы, начиная со 2-го, сохраняются с данными из первой строки экселя. Предполагаю что это происходит из-за того, что перед сохранением в пдф, сохраняется вордовский файл с данными из первой строки, а потом он же берется опять за основу и так по кругу. В итоге на выходе все файлы с разным названием, но одинаковыми данными внутри. И сам шаблон уже без "@...", а с данными из первой строки.

Не могу понять, что не так

Подскажите, куда копать?

Visual Basic

 dim xls, wrd, FSO, Sha, xDir, wDir, sDir, xF, sFiles, xFiles, aa, aWhatFind, aColNums
  Const hdrRows=1 'Число строк заголовков, которые пропускать
  aWhatFind=Array("@фио","@возраст", "@должность", "@название", "@округ", "@район", "@АБ", "@АИ", "@ЛЕ", "@1ЛЕ", "@2ЛЕ", "@3ЛЕ", "@4ЛЕ", "@5ЛЕ", "@6ЛЕ", "@7ЛЕ", "@8ЛЕ", "@9ЛЕ", "@10ЛЕ", "@ЕВ", "@1ЕВ", "@2ЕВ", "@3ЕВ", "@4ЕВ", "@5ЕВ", "@6ЕВ", "@7ЕВ", "@8ЕВ", "@9ЕВ", "@10ЕВ", "@МАиАР", "@1МАиАР", "@2МАиАР", "@3МАиАР", "@4МАиАР", "@5МАиАР", "@6МАиАР", "@7МАиАР", "@8МАиАР", "@9МАиАР", "@10МАиАР") 'массив того, что искать в word-шаблоне
  aColNums =Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42) 'массив номеров колонок Escel-файла для замены
  Set FSO = CreateObject("Scripting.FileSystemObject") 
  
  xDir = FSO.GetAbsolutePathname("") ' xlsx ищем в текущей папке
  sDir = xDir 'папка, где лежат шаблоны, пока пишем текущую папку 
  wDir = xDir 'папка, куда кладём готовый результат. пока в текущую
  with  CreateObject("Shell.Application")
    Set sFiles = .NameSpace(sDir).Items() 'всё что есть в папке шаблонов
    Set xFiles = .NameSpace(xDir).Items() 'пока то же
  end with
  sFiles.Filter 64, "*.dotx" 'смотрим в папке шаблонов на файлы с такой маской.
  if sFiles.Count < 1 Then 'ФАЙЛОВ НЕТ
    wsh.echo "Нет шаблонов В папке " & wDir
    wsh.quit
  end if
  xFiles.Filter 64, "*.xlsx" 'смотрим в папке xlsx только на файлы с такой маской.
  if xFiles.Count < 1 Then 'ФАЙЛОВ НЕТ
    wsh.echo "Нет файлов *.xlsx В папке " & xDir
    wsh.quit
  end if
 
  Set xls = CreateObject("Excel.Application")
  xls.Visible = True 'лучше потом поменять на false, чтобы Excel открывался невидимым
  Set wrd = CreateObject("Word.Application")
  wrd.Visible = True 'лучше потом поменять на false, чтобы Word  открывался невидимым
 
  for each xF in xFiles 'переберём все xlsx файлы
    With xls.WorkBooks.Open(xf.Path)
      aa = .Sheets(1).UsedRange.Value
      .Close
    end with
    for iRow = HdrRows+1 to uBound(aa) step 1
      xlRow2Wrd() ' обработаем каждую строку
    next
  next
  xls.quit 'закроем Excel
  wrd.quit 'закроем Word
  Set wrd=Nothing: Set xls=Nothing: Set FSO=Nothing: Set Sha=Nothing
  Set sFiles=Nothing: Set xFiles=Nothing: Set xF=Nothing 'очистим объекты
  wsh.echo "Я кончила! Твоя очередь." 
  wsh.quit
 
Sub xlRow2Wrd()
  dim fName
  const Repl=""".,&@#№'<>"
  for each sF in sFiles
    with wrd.documents.Open(sF.Path)
      for ii = 0 to uBound(aColNums) step 1
        if aColNums(ii) <= uBound(aa,2) then
          .Content.Find.Execute aWhatFind(ii), False, False, False, False, False, True, 1, False, aa(iRow,aColNums(ii)), 2
        end if
      next
      fName = aa(iRow,aColNums(0))
      for ii=1 to Len(Repl) step 1
        fName = replace(fName,Mid(repl,ii,1),"")
      next
      .SaveAs2 FSO.BuildPath (wDir, fName),17
      .Close
    end with
  next
end sub

@Smailm 0 / 0 / 0 Регистрация: 01.05.2022 Сообщений: 7
	02.05.2022, 20:52	46
	Punkt5, все работает, благодарю Добавлено через 1 час 2 минуты Punkt5, подскажите, что нужно скорректировать в скрипте, чтобы наименование файла формировалось не только по данным из первой колонки? Нужно, чтобы наименование файла бралось одновременно из двух колонок: 1 и 12. Тут логика наименования файла такая, колонка 1 всегда статическая запись, а колонка 12 это дата, которая задается в ручную. 0

shanemac51 Модератор 12080 / 4940 / 791 Регистрация: 07.08.2010 Сообщений: 14,492 Записей в блоге: 4
	04.05.2022, 08:53	48
	Сообщение от Smailm Попытался вставить вашу часть кода, но скрипт перестал работать наверное я его неправильно включил в скрипт. Подскажите, пожалуйста, как его надо корректно туда добавить? я не люблю работать с внешними скриптами - предпочитаю код запускать из екселя, в котором возможны варианты - запуск кода для конкретной строки - для нескольких строк, например помеченных галочкой - для отфильтрованных(например по дате или городу или ....) - для всех - это крайний случай, чаще требуется формирование для выборки .... причем ексель позволяет проводить фильтрацию/ поиск по любому из ваших 20 столбцов с предварительным просмотром выборки Добавлено через 3 минуты Сообщение от Ируся Есть файл word подготовленный по методу слияния и состоящий из 2000 страниц все таки, что вам требуется - есть 2000 страниц ворда, надо получить 2000 документов ворда - есть 2000 строк в екселе, надо получить те же 2000 документов ворда я бы видимо предпочла иметь 2000 листов в екселе(лист для акта) , которые для печати программно переводила бы в ворд, причем код не зависел бы от каталога размещения и мог запускаться из любого ексель-файла с данной структурой размещения информации вашу схему (строка=акт) всегда можно получить программо, если потребуется для каких-то справок 0

@Ируся 3 / 3 / 0 Регистрация: 24.07.2015 Сообщений: 76
		1
	При слиянии в word из excel сохранить в отдельный файл с названиями по определенному полю 19.04.2022, 12:45. Показов 16131. Ответов 48 Метки excel, vba, vba word, word, макрос (Все метки) Добрый день! Есть файл word подготовленный по методу слияния и состоящий из 2000 страниц. Или сделать сразу из файла слияния такое сохранение. Нужно сохранить каждую станицу в отдельный файл каждый под своим именем (наименование организации) которое состоит в вверху страницы и может содержать буквы и/или цифры и/или кавычки. Помогите, пожалуйста, с макросом. Спасибо. 0

@Smailm 0 / 0 / 0 Регистрация: 01.05.2022 Сообщений: 7
	02.05.2022, 13:10	42
	Punkt5, огромное спасибо за ваш ответ! Все работает! Единственное только после слияния, текст обязанностей выглядит одной строкой, т.е. не учитывается перенос строки. Миниатюры 0