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

[Serg2010]

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



Имеется файл формата Excel 2003 (Список.xls), содержащий простой список (фио человека, адрес, телефон и т.д.).

Также имеется файл формата Excel 2003 (Опись.xls), представляющий собой что-то типа образца-шаблона, где в шапке написано название документа (опись и т.д.) и в конце имя начальника, подпись и т.д.

А в середине (теле) шаблона N-е количество строк списка из файла Список.xls (пусть 20). А лучше чтоб задавалось.

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



Спасибо.

[azbest]

Serg2010,

Вы можете всё это сделать сами.

Встроенный язык VBA в офис2003 - вам поможет.

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

[Serg2010]

Добрый день!





Сделал по вашему совету скрипт-запись. Получилось.

Прилагаю файл шаблона (Опись.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

[azbest]

'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



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



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

[azbest]

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