Макрос на VBA Excel – Формируем документы по шаблону

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

Немного поясню задачу, допустим, нам необходимо сформировать какие-то специфические документы по шаблону массово, т.е. в итоге их получится очень много, как я уже сказал выше, например, по каждому сотруднику. И это нужно сделать непосредственно в Excel, если было бы можно это сделать в Word, то мы бы это сделали через «Слияние», но нам нужно именно в Excel, поэтому для этой задачи мы будем писать макрос.

Мы с Вами уже выгружали данные по шаблону через клиент Access из базы MSSql 2008 в Word и Excel вот в этой статье —  Выгрузка данных из Access в шаблон Word и Excel. Но сейчас допустим, у нас данные располагаются в базе, в клиенте которой нельзя или слишком трудоемко реализовать такую задачу, поэтому мы просто выгрузим необходимые данные в Excel и на основе таких данных по шаблону сформируем наши документы.

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

Напомню, что на данном сайте тема VBA Excel уже затрагивалась, например, в материале – Запрет доступа к листу Excel с помощью пароля

И так приступим!

Пишем макрос на VBA Excel по формированию документов

Реализовывать нашу задачу будем на примере «Электронной карточке сотрудника» (я это просто придумал:), хотя может такие и на самом деле есть), т.е. документ в котором хранится личные данные сотрудника вашего предприятия, в определенном виде, именно в Excel.

Примечание! Программировать будем в Excel 2010.

И для начала приведем исходные данные, т.е. сами данные и шаблон

Данные.

Скриншот 1

Лист, на котором расположены эти данные так и назовем «Данные»

Шаблон.

Скриншот 2

Лист, на котором расположен шаблон, тоже так и назовем «Шаблон»

Далее, нам необходимо присвоить имена полей для вставки, так более удобней к ним обращаться чем, например, по номеру ячейки.

Это делается очень просто, выделяете необходимую ячейку или диапазон, и жмете правой кнопкой мыши и выбираете «Присвоить имя», пишите имя ячейки и жмете «ОК»

Скриншот 3

Свои поля я назвал следующим образом:

  • ФИО – fio;
  • № — number;
  • Должность – dolgn;
  • Адрес проживания – addres;
  • Тел. № сотрудника – phone;
  • Комментарий – comment.

Код макроса на VBA Excel

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

Примечание! По умолчанию данной вкладке в Excel 2010 может и не быть, чтобы ее отобразить нажмите правой кнопкой по ленте пункт меню «Настройка ленты»

Скриншот 4

затем, в правой области поставьте галочку напротив пункта «Разработчик»

Скриншот 5

После вкладка разработчик станет отображаться на ленте.

Далее, когда Вы откроете вкладку разработчик и нажмете кнопку «Макросы» у Вас отобразится окно создания макроса, Вы пишите название макросы и жмете «создать».

Скриншот 6

После у Вас откроется окно редактора кода, где собственно мы и будем писать свой код VBA. Ниже представлен код, я его как обычно подробно прокомментировал:

Sub Карточка()
'Книга
NewBook = ""
' Путь, где будут храниться наши карточки
' Т.е. в той папке, откуда запустился файл с макросом
Path = ThisWorkbook.Path
' Выбираем лист с данными
Sheets("Данные").Select
' Запускаем цикл, скажем на 100000 итераций
' Начиная со второй строки, не учитывая заголовок
For i = 2 To 100000
' Выйдем из него, когда фамилии закончатся, т.е. строки
If Cells(i, 1).Value = "" Then
        i = 100000
    Exit For
End If
' Имя файла карточки, назовем по фамилии
Name_file = Path & "\" & Sheets("Данные").Cells(i, 1).Value & ".xls"
‘Выбираем лист с шаблоном
Sheets("Шаблон").Select
' Присваиваем значения нашим ячейкам, по именам которые мы задавали
    Range("fio").Value = Sheets("Данные").Cells(i, 1).Value & " " & _
        Sheets("Данные").Cells(i, 2).Value & " " & Sheets("Данные").Cells(i, 3).Value
    Range("number").Value = Sheets("Данные").Cells(i, 4).Value
    Range("addres").Value = Sheets("Данные").Cells(i, 5).Value
    Range("dolgn").Value = Sheets("Данные").Cells(i, 6).Value
    Range("phone").Value = Sheets("Данные").Cells(i, 7).Value
    Range("comment").Value = Sheets("Данные").Cells(i, 8).Value
    ' Копируем все
    Cells.Select
    Selection.Copy
    ' Создаем новую книгу или делаем ее активной 
    If NewBook = "" Then
        Workbooks.Add
        NewBook = ActiveWorkbook.Name
    Else
        Workbooks(NewBook).Activate
        Cells(1, 1).Select
    End If
    ' Вставляем данные в эту книгу
    Application.DisplayAlerts = False
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ' Сохраняем с нашим новым названием
    ActiveWorkbook.SaveAs Filename:= _
    Name_file, FileFormat:=xlExcel8, _
    Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
    CreateBackup:=False
    NewBook = ActiveWorkbook.Name
    Application.DisplayAlerts = True
    ' Снова активируем файл с макросом и выбираем лист
    Workbooks("Макрос.xls").Activate
    Sheets("Данные").Select
' Переходим к следующей строке
Next i
' Закроем книгу
Workbooks(NewBook).Close
' Выведем сообщение об окончании
MsgBox ("Выполнено!")
End Sub

Теперь осталось выполнить этот макрос, для этого откройте вкладку разработчик->макросы->выполнить наш макрос:

Скриншот 7

и после выполнения у Вас в той же папке появится вот такие файлы

Скриншот 8

Вот с таким содержимым:

Скриншот 9

Для удобства можете на листе с данными создать кнопку и задать ей событие выполнить наш только что созданный макрос, и после чего простым нажатием выполнять этот макрос. Вот и все! Удачи!

Понравилась статья? Поделиться с друзьями:
Заметки IT специалиста
Комментарии: 13
  1. Аватар
    Юрий

    Добрый день. Хочу использовать Ваш макрос для формирования отчета. Я создал папку «Новая папка» в нее вложил файл Excel. Имя файла Книга1. Подготовил 2 листа : Данные,Шаблон.
    Создал книгу2. Нарисовал кнопку назначил макрос:
    Workbooks.Open Filename:=»E:\Работа2014 2014\TRANSPORT\Нов ая папка\Книга1.xls». По нажатию на кнопку открывается Книга 1 лист «Данные» запускаю макрос выдает ошибку

  2. Админ
    Админ (автор)

    Привет! А зачем ты второй excel файл создал? Кнопку имелось в виду в этом же документе, например, на листе с данными. Если просто макрос запускаешь, без кнопки, работает?

  3. Аватар
    Максим

    Добрый день! Спасибо, очень полезный макрос. Начал корректировать его на свой лад и столкнулся с проблемой:Когда создается новая книга на основе шаблона, то 1) сбивается расположение листа на вертикальное(в шаблоне-горизонтальное положение, т.е. альбомное). 2)В некоторых строках, не во всех, сбивается их высота, и получается часть текста не видна. В связи с этими проблемами полностью сбиваются все границы печати. Файл должен распечатываться на 3-х горизонтально расположенных листах. Можете что-нибудь посоветовать?

  4. Аватар
    Игорь

    Добрый день!
    Подскажите, как изменить макрос, чтобы создавался документ только одного сотрудника по одной строке). Например, сотрудника, фамилия которого в активной ячейке.

  5. Аватар
    Елена

    Есть документ *.xlsx с готовой «Шапкой», как с помощью запуска макроса копировать шапку в любой лист и документ *.xlsx?

  6. Аватар
    илья

    добрый день. cвоздано большое количество документов слиянием. все документы длинной в одну страницу сохранены одним большим файлом word. есть макрос по разделению их на каждую страницу, но он присваивает каждому имя в формате «имя_0001; имя_002», и т. д. необходимо их разделить и присвоить имя из соответствующей ячейки excel. есть ли такие макросы?

  7. Аватар
    Evgeny

    Не создает новый файл, строка workbooks(newbo ok).activate
    подсвечена желтым

    1. Админ
      Админ (автор)

      У меня работает, проверь название переменной newbook (в название не должно быть пробелов), или попробуй изменить во всех местах название этой переменной, например, на MyBook

      1. Аватар
        Александр

        Добрый день, возвращаясь к вопросу Evgeny, у меня тоже не создавался новый файл, т.к. в коде условие: или активируется новый файл или создается новый файл, но мы же не создавали новый файл, поэтому программа и останавливалась. Сначала перескакивает из цикла и затем останавливается. Убрал условие на активацию нового файла, только создание и программа начала работать. Условие закомментил. Цикл ‘ Создаем новую книгу или делаем ее активной
        If NewBook = «» Then
        Workbooks.Add
        NewBook = ActiveWorkbook.Name
        Else
        Workbooks(NewBook).Activate
        Оставил только
        Workbooks.Add
        NewBook = ActiveWorkbook.Name
        Может по-другому можно устранить этот вопрос?

  8. Аватар
    Evgeny

    Если не сложно, подскажите пожалуйста как нужно изменить данный макрос, что бы он создавал новые листы с данными по шаблону, а не файлы.

    1. Админ
      Админ (автор)

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

      Sub Карточка()
      ‘ Выбираем лист с данными
      Sheets(«Данные»).Select
      ‘ Запускаем цикл, скажем на 100000 итераций
      ‘ Начиная со второй строки, не учитывая заголовок
      For i = 2 To 100000
      ‘ Выйдем из него, когда фамилии закончатся
      If Cells(i, 1).Value = «» Then
      i = 100000
      Exit For
      End If
      ‘Выбираем лист с шаблоном
      Sheets(«Шаблон»).Select
      ‘ Присваиваем значения нашим ячейкам, по именам которые мы задавали
      Range(«fio»).Value = Sheets(«Данные»).Cells(i, 1).Value & » » & _
      Sheets(«Данные»).Cells(i, 2).Value & » » & Sheets(«Данные»).Cells(i, 3).Value
      Range(«number»).Value = Sheets(«Данные»).Cells(i, 4).Value
      Range(«addres»).Value = Sheets(«Данные»).Cells(i, 5).Value
      Range(«dolgn»).Value = Sheets(«Данные»).Cells(i, 6).Value
      Range(«phone»).Value = Sheets(«Данные»).Cells(i, 7).Value
      Range(«comment»).Value = Sheets(«Данные»).Cells(i, 8).Value

      ‘ Копируем все
      Cells.Select
      Selection.Copy

      ‘ Создаем новый лист
      Worksheets.Add.Name = Sheets(«Данные»).Cells(i, 1).Value

      ‘ Вставляем данные на этот лист
      Application.DisplayAlerts = False
      ActiveSheet.Paste
      Application.CutCopyMode = False

      Sheets(«Данные»).Select
      ‘ Переходим к следующей строке
      Next i

      ‘ Выведем сообщение об окончании
      MsgBox («Выполнено!»)
      End Sub

  9. Аватар
    Анатолий

    Спасибо! Полезно!

  10. Аватар
    Татьяна

    Какое Вам огромное спасибо!!! :smile: Этот код невероятное спасение :!:

Добавить комментарий

;-) :| :x :twisted: :smile: :shock: :sad: :roll: :razz: :oops: :o :mrgreen: :lol: :idea: :grin: :evil: :cry: :cool: :arrow: :???: :?: :!:
Нажимая на кнопку «Отправить комментарий», я даю согласие на обработку персональных данных и принимаю политику конфиденциальности.