Макрос форматирования заголовка таблицы
Очень часто мне присылают для обработки файлы, в которых заголовки таблиц никак не отформатированы, что затрудняет работу с такими таблицами.
Поскольку выполнять вручную каждый раз одни и те же действия надоедает, бы написан этот простенький макрос.
Что он делает: (действия выполняются с выделенным диапазоном ячеек)
- устанавливает выравнивание текста ячеек по центру
- разрешает перенос текста ячеек по словам
- закрашивает ячейки серым цветом
- рисует рамку вокруг ячеек
- закрепляет строку, расположенную непосредственно под выделенным заголовком
- (чтобы заголовок таблицы не прокручивался при скроллинге)
Sub ФорматированиеВыделенногоЗаголовка() On Error Resume Next Dim ra As Range: Set ra = Selection With ra .Font.Bold = True .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = True .Interior.ColorIndex = 15 With .Borders .LineStyle = xlContinuous .Weight = xlThin End With End With Set ra = Intersect(ra.Cells(ra.Cells.Count).Offset(1).EntireRow, ra.Cells(1).EntireColumn) ra.Select: ActiveWindow.FreezePanes = True End Sub
- 11874 просмотра
Не получается применить макрос? Не удаётся изменить код под свои нужды?
Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.
0 / 0 / 0 Регистрация: 07.05.2014 Сообщений: 4 |
|
1 |
|
Макрос. Закрепить шапку18.10.2015, 14:22. Показов 4321. Ответов 2
Всем привет! Каким образом можно закрепить шапку во всем документе эксель? Учитывая, что на каждом листе диапазон шапки различается.
0 |
KoGG 5590 / 1580 / 406 Регистрация: 23.12.2010 Сообщений: 2,366 Записей в блоге: 1 |
||||
19.10.2015, 16:02 |
2 |
|||
0 |
The_Prist 1337 / 308 / 74 Регистрация: 13.11.2008 Сообщений: 635 |
||||
19.10.2015, 16:10 |
3 |
|||
Я бы еще перед закреплением использовал Application.GoTo, чтобы скролл окна сдвинуть. Иначе можно застопорить окно в неожиданном ракурсе, т.к. порой Select автоматом не производит скролл окна(часто так происходит при применении Application.ScreenUplading = True).
0 |
IT_Exp Эксперт 87844 / 49110 / 22898 Регистрация: 17.06.2006 Сообщений: 92,604 |
19.10.2015, 16:10 |
Помогаю со студенческими работами здесь Как закрепить шапку таблицы в материале? Есть таблица,как ей закрепить шапку
Искать еще темы с ответами Или воспользуйтесь поиском по форуму: 3 |
Очень часто мне присылают для обработки файлы, в которых заголовки таблиц никак не отформатированы, что затрудняет работу с такими таблицами.
Поскольку выполнять вручную каждый раз одни и те же действия надоедает, бы написан этот простенький макрос.
Что он делает: (действия выполняются с выделенным диапазоном ячеек)
- устанавливает выравнивание текста ячеек по центру
- разрешает перенос текста ячеек по словам
- закрашивает ячейки серым цветом
- рисует рамку вокруг ячеек
- закрепляет строку, расположенную непосредственно под выделенным заголовком
- (чтобы заголовок таблицы не прокручивался при скроллинге)
Sub ФорматированиеВыделенногоЗаголовка()
On Error Resume Next
Dim ra As Range: Set ra = Selection
With ra
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Interior.ColorIndex = 15
With .Borders
.LineStyle = xlContinuous
.Weight = xlThin
End With
End With
Set ra = Intersect(ra.Cells(ra.Cells.Count).Offset(1).EntireRow, ra.Cells(1).EntireColumn)
ra.Select: ActiveWindow.FreezePanes = True
End Sub
- 8906 просмотров
Уважаемые знатоки экселя, добиваюсь упрощения работы решил сам попробовать но появилась загвостка.
Прописал макрос макро рекодером, столкнулся с проблемой необходимо вставить шапку в образовавшейся таблице, в прикрепленом файле имеется пояснения, макрос еще не доработан хочу сам доработать.
Навсякий случай вот сам макрос:
Sub дебиторка()
‘
‘ дебиторка Макрос
‘ дебиторка по доставке
‘
‘
Columns(«C:C»).Select
Selection.Copy
Columns(«M:M»).Select
Selection.Insert Shift:=xlToRight
Columns(«J:J»).Select
Application.CutCopyMode = False
Selection.Copy
Columns(«N:N»).Select
Selection.Insert Shift:=xlToRight
Columns(«E:E»).Select
Application.CutCopyMode = False
Selection.Copy
Columns(«O:O»).Select
ActiveSheet.Paste
Range(«L15:O547»).Select
Application.CutCopyMode = False
Selection.Copy
Workbooks.Add
Range(«B5»).Select
ActiveSheet.Paste
Columns(«D:D»).Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range(«E5»).Select
End Sub
Зарание благадарю.
Очень часто бывает такое, что нужно сформировать документы по определенному шаблону, на основе каких-то данных, например, по каждому сотруднику или по каждому лицевому счету. И делать это вручную бывает достаточно долго, когда этих самых сотрудников или лицевых счетов много, поэтому сегодня мы рассмотрим примеры реализации таких задач в Excel с помощью макроса написанного на VBA Excel.
Немного поясню задачу, допустим, нам необходимо сформировать какие-то специфические документы по шаблону массово, т.е. в итоге их получится очень много, как я уже сказал выше, например, по каждому сотруднику. И это нужно сделать непосредственно в Excel, если было бы можно это сделать в Word, то мы бы это сделали через «Слияние», но нам нужно именно в Excel, поэтому для этой задачи мы будем писать макрос.
Мы с Вами уже выгружали данные по шаблону через клиент Access из базы MSSql 2008 в Word и Excel вот в этой статье — Выгрузка данных из Access в шаблон Word и Excel. Но сейчас допустим, у нас данные располагаются в базе, в клиенте которой нельзя или слишком трудоемко реализовать такую задачу, поэтому мы просто выгрузим необходимые данные в Excel и на основе таких данных по шаблону сформируем наши документы.
В нашем примере мы, конечно, будем использовать простой шаблон, только для того чтобы это было просто наглядно и понятно (только в качестве примера), у Вас в свою очередь шаблон будет, как мне кажется намного сложней.
Напомню, что на данном сайте тема VBA Excel уже затрагивалась, например, в материале – Запрет доступа к листу Excel с помощью пароля
И так приступим!
Реализовывать нашу задачу будем на примере «Электронной карточке сотрудника» (я это просто придумал:), хотя может такие и на самом деле есть), т.е. документ в котором хранится личные данные сотрудника вашего предприятия, в определенном виде, именно в Excel.
Примечание! Программировать будем в Excel 2010.
И для начала приведем исходные данные, т.е. сами данные и шаблон
Данные.
Лист, на котором расположены эти данные так и назовем «Данные»
Шаблон.
Лист, на котором расположен шаблон, тоже так и назовем «Шаблон»
Далее, нам необходимо присвоить имена полей для вставки, так более удобней к ним обращаться чем, например, по номеру ячейки.
Это делается очень просто, выделяете необходимую ячейку или диапазон, и жмете правой кнопкой мыши и выбираете «Присвоить имя», пишите имя ячейки и жмете «ОК»
Свои поля я назвал следующим образом:
- ФИО – fio;
- № — number;
- Должность – dolgn;
- Адрес проживания – addres;
- Тел. № сотрудника – phone;
- Комментарий – comment.
Код макроса на VBA Excel
Для того чтобы написать код макроса, открывайте на ленте вкладку «Разработчик», далее макросы.
Примечание! По умолчанию данной вкладке в Excel 2010 может и не быть, чтобы ее отобразить нажмите правой кнопкой по ленте пункт меню «Настройка ленты»
затем, в правой области поставьте галочку напротив пункта «Разработчик»
После вкладка разработчик станет отображаться на ленте.
Далее, когда Вы откроете вкладку разработчик и нажмете кнопку «Макросы» у Вас отобразится окно создания макроса, Вы пишите название макросы и жмете «создать».
После у Вас откроется окно редактора кода, где собственно мы и будем писать свой код 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
Теперь осталось выполнить этот макрос, для этого откройте вкладку разработчик->макросы->выполнить наш макрос:
и после выполнения у Вас в той же папке появится вот такие файлы
Вот с таким содержимым:
Для удобства можете на листе с данными создать кнопку и задать ей событие выполнить наш только что созданный макрос, и после чего простым нажатием выполнять этот макрос. Вот и все! Удачи!