Excel VBA. Сопоставление заднего цвета текстового поля с .Интерьер.Цвет ячейки

#excel #vba #textbox #backcolor

#excel #vba #текстовое поле #задний цвет

Вопрос:

Кажется, я не могу найти ответ на этот вопрос. У меня есть электронная таблица с пользовательской формой, и я пытаюсь сопоставить цвет обратной стороны TextBox47 с соответствующей ячейкой на листе, значение которой извлекается через Listbox. Что мне нужно, так это иметь возможность щелкнуть элемент списка и текстовое поле для заполнения этим цветом.

У меня есть следующий код для раскрашивания ячеек на листе в соответствии с датой и с именованными диапазонами для параметров.. и это выполняется с помощью UserForm Initialise()

 Dim cell As Range
      With Range("data_table[Date Test]")
    
     
    For Each cell In Range("data_table[Date Test]")
        If cell.Value < Range("Today") Then
            cell.Interior.ColorIndex = 6
            ElseIf cell.Value >= Range("Today") And cell.Value <= Range("Thirty_Days") Then
            cell.Interior.ColorIndex = 3
            ElseIf cell.Value > Range("Thirty_Days") And cell.Value <= Range("Sixty_Days") Then
            cell.Interior.ColorIndex = 45
            ElseIf cell.Value > Range("Sixty_Days") And cell.Value <= Range("Ninety_Days") Then
            cell.Interior.ColorIndex = 43
            ElseIf cell.Value > Range("Ninety_Days") Then
            cell.Interior.ColorIndex = 18

         End If

    Next cell
    End With
  

Это работает нормально, затем я попробовал следующее, чтобы раскрасить текстовое поле

  Private Sub TextBox47_Change()
    Me.TextBox47.Text = Format(TextBox47.Text, "dd/mmm/yyyy")
    Dim cell As Range
For Each cell In Range("data_table[Date Test]")
          With Range("data_table[Date Test]")
    Me.TextBox47.BackColor = .Interior.Color
        Next cell
    
    End With
  

Я думаю, мне нужно где-нибудь добавить следующее..

 TextBox47.Value = Me.ListBox1.List(ListBox1.ListIndex, 65)
  

Который является ссылкой ListBox для текстового поля .. но теперь я начинаю сильно путаться. Я смотрел на это пару дней.


Отредактируйте, чтобы добавить код Listbox, как указано.

     Private Sub ComboBox8_Change()

Dim i As Long

Me.ListBox1.Clear
For i = 2 To Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))
If Sheet1.Cells(i, 10).Value = Me.ComboBox8.Value Then

Me.ListBox1.AddItem Sheet1.Cells(i, 10).Value
'ID Number
Me.ListBox1.List(ListBox1.ListCount - 1, 0) = Sheet1.Cells(i, 1).Value
'Title
Me.ListBox1.List(ListBox1.ListCount - 1, 1) = Sheet1.Cells(i, 2).Value
  

Так было бы что-то вроде этого..

  Private Sub TextBox47_Change()
    Me.TextBox47.Text = Format(TextBox47.Text, "dd/mmm/yyyy")
Me.TextBox47.BackColor = .Interior.Color
    End Sub
  

Что приводит к ошибке компиляции

введите описание изображения здесь1

Более новый код

Теперь я изменил его на это..

 Private Sub TextBox47_Change()
    Dim cell As Range
        Me.TextBox47.Text = Format(TextBox47.Text, "dd/mmm/yyyy")
            With Range("data_table[Date Test]")
                Me.TextBox47.BackColor = Range("data_table[Date Test]").Interior.Color
            End With
End Sub
  

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

 Private Sub TextBox47_Change()
        Dim cell As Range
            Me.TextBox47.Text = Format(TextBox47.Text, "dd/mmm/yyyy")
                With Range("data_table[Date Test]")
                    Me.TextBox47.BackColor = Range("cell").Interior.Color
                End With
    End Sub
  

Но это просто остановилось из-за ошибки времени выполнения 1004

Еще одно редактирование.. пожалуйста, скажите мне, является ли постоянное добавление к этому сообщению неправильным способом сделать это.

введите описание изображения здесь

Это, при наведении курсора мыши, на самом деле собирает правильную информацию из ячейки, которую я ищу (я пробовал разные, чтобы убедиться), в списке выбора, на который я нажимаю, так что, я думаю, теперь это случай указания интерьера.Цвет для отображения выбранной ячейки?

Комментарии:

1. Как связаны значение ячейки и поле списка?

2. Отредактировано @SJR.. В какой-то момент у меня это было.. просто много мозгов зависает .. извините. Теперь цвет обратной стороны текстового поля становится черным

3. Вероятно, так и должно быть With cell , но я не понимаю, почему вы перебираете диапазон, поскольку цвет текстового поля будет использовать только последнее значение в цикле. Опубликованный код все равно не будет работать, так как end with должен находиться внутри цикла.

4. В окне списка отображаются 6 столбцов листа, на котором выполняется A — BQ «Private Sub ComboBox8_Change() Dim i, пока я.ListBox1.Clear Для i = 2 для приложения. WorksheetFunction. Количество(Лист1. Диапазон («A: A»)), если Лист1. Ячейки (i, 10).Значение = Me.ComboBox8.Значение Затем Me.ListBox1.Дополнительный лист1. Ячейки (i, 10).Значение ‘Идентификационный номер Me.ListBox1.List(ListBox1.listCount — 1, 0) = Лист1. Ячейки (i, 1).Значение ‘Title Me.ListBox1.List(ListBox1.listCount — 1, 1) = Лист1. Ячейки (i, 2).Значение» и т.д..

5. Извините, не удалось выяснить, как поместить код в поле для комментариев

Ответ №1:

Мне удалось заставить это работать … хотя и не уверен, что это самое элегантное решение. 🙂

Чтобы не путать его с приведенным выше кодом, который стал немного бессвязным и беспорядочным, вот весь новый рабочий код и объяснение, которое я придумал

Код для раскрашивания ячеек на листе:

 Dim cell As Range
  
      For Each cell In Range("data_table[Date Reviewed]")
        If cell.Value < Range("Today") Then
            cell.Interior.ColorIndex = 7  'Magenta
            ElseIf cell.Value >= Range("Today") And cell.Value <= Range("Thirty_Days") Then
            cell.Interior.ColorIndex = 3  'Red
            ElseIf cell.Value > Range("Thirty_Days") And cell.Value <= Range("Sixty_Days") Then
            cell.Interior.ColorIndex = 45  'Orange
            ElseIf cell.Value > Range("Sixty_Days") And cell.Value <= Range("Ninety_Days") Then
            cell.Interior.ColorIndex = 4  'Green
            ElseIf cell.Value > Range("Ninety_Days") Then
            cell.Interior.ColorIndex = 19  'Beige
        End If

    Next cell
  

Это в UserForm_Initialize()

А затем, чтобы сопоставить цвет ячейки с TextBox.BackColor , я использовал ListBox.ListIndex для получения даты, используя следующий код:

 Private Sub TextBox47_Change()

      Me.TextBox47.Text = Format(TextBox47.Text, "dd/mm/yyyy")
      
                    If (Me.ListBox1.List(ListBox1.ListIndex, 65)) < Range("Today") Then
                     TextBox47.BackColor = RGB(255, 0, 255)  'Magenta
                ElseIf (Me.ListBox1.List(ListBox1.ListIndex, 65)) >= Range("Today") And (Me.ListBox1.List(ListBox1.ListIndex, 65)) <= Range("Thirty_Days") Then
                     TextBox47.BackColor = RGB(255, 0, 0)  'Red
                ElseIf (Me.ListBox1.List(ListBox1.ListIndex, 65)) > Range("Thirty_Days") And (Me.ListBox1.List(ListBox1.ListIndex, 65)) <= Range("Sixty_Days") Then
                     TextBox47.BackColor = RGB(255, 153, 0)  'Orange
                ElseIf (Me.ListBox1.List(ListBox1.ListIndex, 65)) > Range("Sixty_Days") And (Me.ListBox1.List(ListBox1.ListIndex, 65)) <= Range("Ninety_Days") Then
                     TextBox47.BackColor = RGB(0, 255, 0)  'Green
                ElseIf (Me.ListBox1.List(ListBox1.ListIndex, 65)) > Range("Ninety_Days") Then
                     TextBox47.BackColor = RGB(255, 255, 204)  'Beige
        End If
        
     End Sub
  

Теперь я могу вызвать это, TextBox.BackColor чтобы установить ассоциированное Interior.Color значение для любой другой ячейки, в которую я пересылаю это значение, например, для отчета, который я создаю в Sheet2:

 Sheet2.Range("D105").Value = Me.TextBox47.Text
Sheet2.Range("D105").Interior.Color = Me.TextBox47.BackColor
  

Спасибо за вашу помощь и терпение. Это был ваш комментарий «Итак, у вас есть listbox, который возвращает дату», который помог мне увидеть, откуда я на самом деле получал дату при наведении курсора мыши на строку кода, вместо того, чтобы видеть конкретное Cell.Address , и, следовательно, как я заставил вышеупомянутое работать.

Еще раз спасибо, и я надеюсь, что за это время я не нарушил слишком много правил публикации. 🙂

Прошу прощения, но я нигде не смог увидеть кнопку «Спасибо».

Приветствия

Лиам