Блог

Мой макрос Excel считывает ответы на опрос из набора файлов Excel. Ответы опроса содержат оценку (от 1 до 4) и описание. Цель состоит в том, чтобы сгенерировать матрицу. Каждая ячейка матрицы имеет цвет, который представляет счет. Я хотел бы, чтобы пользователь мог изменять расположение этих ячеек. Чтобы упростить его для пользователя, я создал матрицу шаблонов и кнопку. Пользователь должен иметь возможность изменять расположение ячеек, и при нажатии кнопки должен быть создан набор стилей (оценка 1, оценка 2, …). После создания матрицы Рабочая книга должна функционировать без файлов опроса.

Я попробовал несколько вещей:

Попробуйте 1

 ThisWorkbook.Styles.Add "Score 1", BasedOn:=cell1
  

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

Попробуйте 2

 ThisWorkbook.Styles("Score 1").Delete
ThisWorkbook.Styles.Add "Score 1", BasedOn:=cell1
  

Это не очень хорошая идея: все ячейки теряют свой стиль при повторном выполнении.

Попробуйте 3: Текущий

Скопируйте наиболее часто используемые свойства макета ячеек и скопируйте их в стиль. Если этот стиль был удален пользователем, он создается заново. Эта процедура не идеальна, поскольку большинство свойств стиля не будут охвачены.

Есть ли способ обновить стиль ячейки, который является более общим? Я бы хотел, чтобы было как можно меньше места для приведения рабочей книги в непоследовательное и нефункциональное состояние.

Я придерживался попытки 3. Поскольку для всех свойств, которые, казалось, можно было редактировать, требовалось много кода, а копирование границ — сложная задача, я публикую результат.

 'xR1_Template: the cell to base the style on
'nm_Style:    the name of the style
Public Function Upsert_Style(xR1_Template As Excel.Range, nm_Style As String) As Excel.Style
  
    Dim xStyle As Excel.Style
    Set xStyle = Fn.TryGet(ThisWorkbook.Styles, nm_Style)
    If Fn.IsNothing(xStyle) Then
        Set xStyle = ThisWorkbook.Styles.Add(nm_Style)
    End If

    xStyle.Font.Color = xR1_Template.Font.Color
    xStyle.Font.Bold = xR1_Template.Font.Bold
    xStyle.Font.Name = xR1_Template.Font.Name
    xStyle.Font.Italic = xR1_Template.Font.Italic
    xStyle.Font.Size = xR1_Template.Font.Size
    xStyle.Font.Strikethrough = xR1_Template.Font.Strikethrough
    xStyle.Font.Subscript = xR1_Template.Font.Subscript
    xStyle.Font.Superscript = xR1_Template.Font.Superscript

    xStyle.Font.Underline = xR1_Template.Font.Underline
    
    xStyle.Interior.Color = xR1_Template.Interior.Color
    xStyle.Interior.Pattern = xR1_Template.Interior.Pattern
    xStyle.Interior.PatternColor = xR1_Template.Interior.PatternColor

    'NOTE: necessary to delete all borders first. There's no way to delete them one by one.
    xStyle.Borders.LineStyle = xlNone
    
    Dim iBorder As Long
    For iBorder = 1 To xR1_Template.Borders.Count

       Dim xBorder As Excel.Border
       'NOTE:  The Borders property claims to work with xlBordersIndex argument, but this is not true.
    '       Normal indexing is used.
       Set xBorder = xR1_Template.Borders(iBorder)


       'NOTE:  "none-style" borders (=no border), should be skipped.
       '       Once they are retrieved using the Borders property, they are always visible.
       '       Setting them with xlLineStyle.xlLineStyleNone does not hide them.
       If xBorder.LineStyle <> XlLineStyle.xlLineStyleNone Then

            Dim xBorder_Style As Excel.Border
            Set xBorder_Style = xStyle.Borders(iBorder)

            xBorder_Style.Color = xBorder.Color
            xBorder_Style.LineStyle = xBorder.LineStyle
            xBorder_Style.Weight = xBorder.Weight
            
        End If

    Next iBorder
    
    xStyle.AddIndent = xR1_Template.AddIndent
    xStyle.FormulaHidden = xR1_Template.FormulaHidden
    xStyle.HorizontalAlignment = xR1_Template.HorizontalAlignment
    xStyle.IndentLevel = xR1_Template.IndentLevel
    xStyle.NumberFormat = xR1_Template.NumberFormat
    xStyle.NumberFormatLocal = xR1_Template.NumberFormatLocal
    xStyle.Orientation = xR1_Template.Orientation
    xStyle.ShrinkToFit = xR1_Template.ShrinkToFit
    xStyle.VerticalAlignment = xR1_Template.VerticalAlignment
    xStyle.WrapText = xR1_Template.WrapText
    xStyle.IndentLevel = xR1_Template.IndentLevel

    Set Upsert_Style = xStyle
    
End Function