Excel VBA将文本框的背景色与单元格的.Interior.Color相匹配

问题描述

我似乎找不到答案。我有一个带有用户窗体的电子表格，我正在尝试将TextBox47的底色与工作表上的相应单元格相匹配，其值是通过列表框获取的。我需要的是能够单击列表项，然后在文本框中填充该颜色。

我有以下代码可以根据日期为工作表中的单元格着色，并使用参数的命名范围..并在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)

哪个是TextBox的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

哪个出现编译错误

enter image description here

更新的代码

我现在将其更改为此。

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

至少不会引发错误，但是在每次选择时，BackColor都是黑色的。我从..

开始

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时停止了

再编辑一次。.请告诉我，如果持续添加到该帖子中是错误的操作方式。

这实际上是当我将鼠标悬停在上方时，在我单击的“列表框”选择中，从我所关注的单元格中获取了正确的信息（我尝试过不同的操作以确保）。这是一种告诉Interior.Colour查看所选择的单元格的情况？

解决方法

我设法使它开始工作。尽管不确定这是否是最优雅的解决方案。：）

为了避免与上面的代码混淆，上面的代码有些混乱和混乱，这是所有新的工作代码以及我想出的解释

为工作表中的单元格着色的代码：

// Wait until the page has loaded
document.addEventListener('DOMContentLoaded',() => {
  var field_to_update = document.getElementById('reactionForm_strongestTrack');
  field_to_update.innerHTML = '';
  var elOptNew = document.createElement('option');
  elOptNew.text = '---'
  elOptNew.value = '';
  field_to_update.add(elOptNew);
  field_to_update.options[0].selected = true;

  // Search for all playlist-captions inside the playlist-tracks list.
  // 'Currently playing' has a playlist-caption too,// limiting to the tracklist excludes it
  document.querySelectorAll('.wp-playlist-tracks .wp-playlist-caption')
    .forEach( // The following arrow function will be called for each element
      track => {
        // There are nested elements but we just want the plaintext    
        let track_name = track.innerText;
        // Create a new element and append to the select as before
        let elOptNew = document.createElement('option');
        elOptNew.text = track_name.replace("&amp;","&");
        elOptNew.value = track_name;

        field_to_update.add(elOptNew);
      });
});

这是在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,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) '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,204) 'Beige End If End Sub来设置要转发给该值的其他任何单元格的关联TextBox.BackColor，例如我在Sheet2中生成的报告：

Interior.Color

感谢您的帮助和耐心。这是您的注释“因此，您有一个返回日期的列表框”，这使我了解了将鼠标悬停在代码行上时实际从何处获取日期，而不是看到特定的Sheet2.Range("D105").Value = Me.TextBox47.Text Sheet2.Range("D105").Interior.Color = Me.TextBox47.BackColor，因此我如何使上述工作正常进行的。

再次感谢您，希望我在此期间不要破坏太多的发布规则。：）

抱歉，我在任何地方都看不到谢谢按钮。

欢呼

利亚姆

backcolor backcolor excel excel textbox textbox vba