Private Sub TextBox1_Change()
Dim cell As Range
For Each cell In Sheet1.Range("b2", Sheet1.Range("b1500").End(xlUp).Address)
If cell.Value = TextBox1.Value Then
Dim cColor, cRed, cGreen, cBlue
cColor = Range(cell.Address).Font.Color
'Convert Color Code to RGB
cRed = (cColor Mod 256)
cGreen = (cColor \ 256) Mod 256
cBlue = (cColor \ 65536) Mod 256
TextBox1.ForeColor = RGB(cRed, cGreen, cBlue)
cColor = Range(cell.Address).Offset(0, 1).Font.Color
cRed = (cColor Mod 256)
cGreen = (cColor \ 256) Mod 256
cBlue = (cColor \ 65536) Mod 256
TextBox8.ForeColor = RGB(cRed, cGreen, cBlue)
cColor = Range(cell.Address).Offset(0, 2).Font.Color
cRed = (cColor Mod 256)
cGreen = (cColor \ 256) Mod 256
cBlue = (cColor \ 65536) Mod 256
TextBox9.ForeColor = RGB(cRed, cGreen, cBlue)
cColor = Range(cell.Address).Offset(0, 3).Font.Color
cRed = (cColor Mod 256)
cGreen = (cColor \ 256) Mod 256
cBlue = (cColor \ 65536) Mod 256
TextBox10.ForeColor = RGB(cRed, cGreen, cBlue)
TextBox8 = cell.Offset(0, 1)
TextBox9 = cell.Offset(0, 2)
TextBox10 = cell.Offset(0, 3)
End If
Next cell
On Error Resume Next
End Sub
Private Sub TextBox1_Change()
Dim cell As Range
For Each cell In Sheet1.Range("b2", Sheet1.Range("b1500").End(xlUp).Address)
If cell.Value = TextBox1.Value Then
Dim cColor, cRed, cGreen, cBlue
cColor = Range(cell.Address).Font.Color
'Convert Color Code to RGB
cRed = (cColor Mod 256)
cGreen = (cColor \ 256) Mod 256
cBlue = (cColor \ 65536) Mod 256
TextBox1.foreColor = RGB(cRed, cGreen, cBlue)
cColor = Sheet1.Range(cell.Address).Offset(0, 1).Font.Color
cRed = (cColor Mod 256)
cGreen = (cColor \ 256) Mod 256
cBlue = (cColor \ 65536) Mod 256
TextBox8.foreColor = RGB(cRed, cGreen, cBlue)
cColor = Sheet1.Range(cell.Address).Offset(0, 2).Font.Color
cRed = (cColor Mod 256)
cGreen = (cColor \ 256) Mod 256
cBlue = (cColor \ 65536) Mod 256
TextBox9.foreColor = RGB(cRed, cGreen, cBlue)
cColor = Sheet1.Range(cell.Address).Offset(0, 3).Font.Color
cRed = (cColor Mod 256)
cGreen = (cColor \ 256) Mod 256
cBlue = (cColor \ 65536) Mod 256
TextBox10.foreColor = RGB(cRed, cGreen, cBlue)
TextBox8 = cell.Offset(0, 1)
TextBox9 = cell.Offset(0, 2)
TextBox10 = cell.Offset(0, 3)
End If
Next cell
On Error Resume Next
End Sub
کامنت