Создание группы файлов Excel на основе списка
 

Добрый вечер! Помогите, плиз, со скриптом:

Имеется файл формата Excel 2003 (Список.xls), содержащий простой список (фио человека, адрес, телефон и т.д.).
Также имеется файл формата Excel 2003 (Опись.xls), представляющий собой что-то типа образца-шаблона, где в шапке написано название документа (опись и т.д.) и в конце имя начальника, подпись и т.д.
А в середине (теле) шаблона N-е количество строк списка из файла Список.xls (пусть 20). А лучше чтоб задавалось.
Нужен скрипт, создающий из списка на основе этого шаблона отдельные файлы. Т.е. файл с именем Опись001.xls содержащий первые 20 строк списка, потом Опись002.xls со списком с 21 по 40 строку и т.д. пока не кончится весь список. Если бы просто выводить так на печать я бы справился, но надо чтоб были в виде файлов эти описи ...

Спасибо.

Serg2010,
Вы можете всё это сделать сами. :yes:
Встроенный язык VBA в офис2003 - вам поможет.
для этого сначала вам надо самому проделать все действия что Вы написали над вашими файлами. Открыть файл шаблон -пустую незаполненную таблицу с подписью начальника внизу, далее открыть искомый файл из которого выбудете дергать первые двадцать строк. Далее выделисть первые двадцать строк в искомом файле и скопировать (а лучше - вырезать) их в пустой файл шаблон с подписью началника внизу. Сохранить шаблон как (указать имя файла). Следующие действия будут точно такими же. Если без всякого скрипта у Вас получиться - то терерь вам нужно ваш искомый файл с кучей записей - сохранить под другим именем (чтоб в случае неудачи - не запороть ваш оригинальный файл) и работать с ним. Открыв этот файл вы нажимаете Сервис - Макросы- Начать запись. В появившемся окошке англицкими буквами пишете имя макроса - например sortirovrka_spiska и добавляете сочетание клавиш - например ctrl+o. нажимаете ОК и повторяете все те дейсвия что делали без включения макроса (копирование или вырезание первых 20 строк из списка в пустую таблицу шаблон с подписью началника). Жмёте на кнопку стоп. Далее нажимаете ALT+F8 и в появившемся окне выбираете имя вашего макроса и нажимаете кнопку ИЗМЕНИТЬ - тогда вы попадете в окно пошагового исполнения всех записанных макросом ваших действий по копированию-вырезанию 20 строк и вставление их в пустую таблицу с последующим её сохранением в файл. когда всё это сделаете - скопируйте текст макроса сюда и дальше мы его немножко подправим.

Добрый день!


Сделал по вашему совету скрипт-запись. Получилось.
Прилагаю файл шаблона (Опись.xls), файл списка источника строк (Список.xls), содержащий скрипт, ну и результат работы файл (Опись001.xls).
Теперь, как понял, нужно подредактировать скриптик, т.е. организовать внешний цикл-счётник для увеличения строк 20, и для нумерации файлов другой цикл. Хорошо бы вставить проверку на предмет окончания списка и т.д. Вообщем теперь в бой идут профессионалы :-)

Файлы должны располагаться по пути C:\Скрипт
Текст скрипта (есть и в модуле файла).

Sub Макрос1()
'
' Макрос1 Макрос
' Макрос записан 21.03.2013 (140801)
'

'
ChDir "C:\Скрипт"
Workbooks.Open Filename:="C:\Скрипт\Опись.xls"
Windows("Список.xls").Activate
Range("B1:C20").Select
Selection.Copy
Windows("Опись.xls").Activate
Range("B8").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:="C:\Скрипт\Опись003.xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
ActiveWorkbook.Close
End Sub

'ActiveSheet.Paste
'Application.CutCopyMode = False

ActiveWorkbook.SaveAs Filename:="C:\Скрипт\Опись & imja_faila & .xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
range("AA1").clearcontent
vybor=inputbox("Формируем следующий файл? Д / Н")
if vybor = "Д" then
goto 5
elseif vybor = "Н" then
end if
ActiveWorkbook.Close
End Sub

Я не имею под рукой экселя и все эту конструкцию представлял в голове. Возможно кое где ошибки с правильным написанием отдельных слов и выражений. но "мысль" в коде правильная :drug:

PS: ПОКА ПИСАЛ - ФОРУМ СБРОСИЛ МОЮ АВТОРИЗАЦИЮ, А ПОСЛЕ ВОССТАНГОВЛЕНИЯ АВТОРИЗАЦИИ - 2/3 КОДА ЗАЖЕВАЛОСЬ. БУДУ ПИСАТЬ ЗАНОВО.

ChDir "C:\Скрипт"
Workbooks.Open Filename:="C:\Скрипт\Опись.xls"
Windows("Список.xls").Activate
range("A1").select
selection.offset(0,1).select
per1=activecell.value
selection.offset(0,1).select
per2=activecell.value
selection.entirerows.insert
range(A1:C1").clearcontent
range("B1").select
selection.offset(a,0).select
activecell.value=per1
selection.offset(0,1).select
activecell.value=per2
5
Windows("Список.xls").activate
for a=1 to 20
range("B1").select
selection.offset(a,0).select
dann1=activecell.value
selection.offset(0,1).select
dann2=activecell.value
selection.entirerows.delete

' Range("B1:C20").Select
' Selection.Copy
Windows("Опись.xls").Activate
Range("B7").Select
selection.offset(a,0).select
activecell.value=dann1
selection.offset(0,1).select
activecell.value=dann2
next a

' ActiveSheet.Paste
' Application.CutCopyMode = False
imja_faila=inputbox("какое имя дадим этому 20 строчному файлу?")
range("AA1").select
activecell.value=imja_faila
imja_faila=activecell.value
ActiveWorkbook.SaveAs Filename:="C:\Скрипт\Опись & imja_faila & .xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
vibor= inputbox("Будем формировать новый файл? Д / Н")
if vibor = "Д" then
goto 5
elseif vibor = "Н" then
end if
ActiveWorkbook.Close
End Sub