Маленькая функция для добавления моего любимого стиля таблицы в активную книгу. Стиль становится стилем по умолчанию. Если стиль с таким именем уже есть - выдаёт сообщение об ошибке.
[vba]
Код
Sub Add_Common_Table_Style() '------------------------------------ 'Author: Roman "Rioran" Voronov 'Date: the 27-th of August, 2015 'Feedback: voronov_rv@mail.ru '------------------------------------ 'This programm adds my lovely table 'style into active workbook. '------------------------------------ Dim ArrX, i% ArrX = Array(xlEdgeTop, xlEdgeBottom, xlEdgeLeft, xlEdgeRight, xlInsideVertical, xlInsideHorizontal) On Error GoTo Not_Performed ActiveWorkbook.TableStyles.Add ("Rio_Style") With ActiveWorkbook.TableStyles("Rio_Style") .ShowAsAvailableTableStyle = True For i = 0 To 5 .TableStyleElements(xlWholeTable).Borders(ArrX(i)).Weight = xlThin Next i .TableStyleElements(xlHeaderRow).Interior.ThemeColor = xlThemeColorAccent6 .TableStyleElements(xlHeaderRow).Interior.TintAndShade = 0.799981688894314 End With ActiveWorkbook.DefaultTableStyle = "Rio_Style" Exit Sub Not_Performed: MsgBox "Error" End Sub
[/vba]
Всем привет.
Маленькая функция для добавления моего любимого стиля таблицы в активную книгу. Стиль становится стилем по умолчанию. Если стиль с таким именем уже есть - выдаёт сообщение об ошибке.
[vba]
Код
Sub Add_Common_Table_Style() '------------------------------------ 'Author: Roman "Rioran" Voronov 'Date: the 27-th of August, 2015 'Feedback: voronov_rv@mail.ru '------------------------------------ 'This programm adds my lovely table 'style into active workbook. '------------------------------------ Dim ArrX, i% ArrX = Array(xlEdgeTop, xlEdgeBottom, xlEdgeLeft, xlEdgeRight, xlInsideVertical, xlInsideHorizontal) On Error GoTo Not_Performed ActiveWorkbook.TableStyles.Add ("Rio_Style") With ActiveWorkbook.TableStyles("Rio_Style") .ShowAsAvailableTableStyle = True For i = 0 To 5 .TableStyleElements(xlWholeTable).Borders(ArrX(i)).Weight = xlThin Next i .TableStyleElements(xlHeaderRow).Interior.ThemeColor = xlThemeColorAccent6 .TableStyleElements(xlHeaderRow).Interior.TintAndShade = 0.799981688894314 End With ActiveWorkbook.DefaultTableStyle = "Rio_Style" Exit Sub Not_Performed: MsgBox "Error" End Sub
Обновил первый пост: перед обработчиком ошибок поставил выход из процедуры. Раньше, даже если всё прошло нормально, код ошибки в конце тоже выполнялся.
Замечу, что изначально обработка ошибок должна показывать, если стиль с таким именем уже есть.
Николай, Сергей, спасибо, что заметили.
Обновил первый пост: перед обработчиком ошибок поставил выход из процедуры. Раньше, даже если всё прошло нормально, код ошибки в конце тоже выполнялся.
Замечу, что изначально обработка ошибок должна показывать, если стиль с таким именем уже есть.Rioran
Роман, Москва, voronov_rv@mail.ru Яндекс-Деньги: 41001312674279
Сообщение отредактировал Rioran - Пятница, 28.08.2015, 10:24