Mrrrr's Forum (VIEW ONLY)
Un forum care ofera solutii pentru unele probleme legate in general de PC. Pe langa solutii, aici puteti gasi si alte lucruri interesante // A forum that offers solutions to some PC related issues. Besides these, here you can find more interesting stuff.
|
Lista Forumurilor Pe Tematici
|
Mrrrr's Forum (VIEW ONLY) | Reguli | Inregistrare | Login
POZE MRRRR'S FORUM (VIEW ONLY)
Nu sunteti logat.
|
Nou pe simpatie:
Anne98
 | Femeie
25 ani
Buzau
cauta Barbat
25 - 50 ani |
|
|
TRaP
Moderator
Inregistrat: acum 6 ani
Postari: 739
|
|
Fill cell with RGB color using R, G, B numbers from cells
Usage:
Syntax: =myRGB(red; green; blue)
Example: =myRGB(A1; B1; C1)
Option Explicit
Function myRGB(r, g, b)
Dim clr As Long, src As Range, sht As String, f, v
If IsEmpty(r) Or IsEmpty(g) Or IsEmpty(b) Then
clr = vbWhite
Else
clr = RGB(r, g, b)
End If
Set src = Application.ThisCell
sht = src.Parent.Name
f = "Changeit(""" & sht & """,""" & _
src.Address(False, False) & """," & clr & ")"
src.Parent.Evaluate f
myRGB = ""
End Function
Sub ChangeIt(sht, c, clr As Long)
ThisWorkbook.Sheets(sht).Range(c).Interior.Color = clr
End Sub |
Determine the Fill Color of a Cell - shows R, G, B values for the cell
Syntax: =COLOR(cell, return_type)
return_type:
0 (default value) /optional
1: Hex /optional
2: RGB /optional
3: Excel color index
Function Color(rng As Range, Optional formatType As Integer = 0) As Variant
Dim cVal As Variant
cVal = rng.Cells(1, 1).Interior.Color
Select Case formatType
Case 1
Color = WorksheetFunction.Dec2Hex(cVal, 6)
Case 2
Color = (cVal Mod 256) & ", " & ((cVal \ 256) Mod 256) & ", " & (cVal \ 65536)
Case 3
Color = rng.Cells(1, 1).Interior.ColorIndex
Case Else
Color = cVal
End Select
End Function |
Source:
|
|
| pus acum 1 an |
|
|
TRaP
Moderator
Inregistrat: acum 6 ani
Postari: 739
|
|
If you save the functions in your PERSONAL.XLSB file, you will have to use the following syntax:
=PERSONAL.XLSB!myRGB(R, G, B)
|
|
| pus acum 1 an |
|
|
TRaP
Moderator
Inregistrat: acum 6 ani
Postari: 739
|
|
If that doesn't work, you can always do a manual QAT / other button click snippet.
Assuming I have R, G, and B colors in adjacent columns, here's a code that works for selection:
Sub Change_Clr()
Dim rng As Range
Set rng = Selection
For Each cell In rng
r = cell.Offset(0, 1).Value
g = cell.Offset(0, 2).Value
b = cell.Offset(0, 3).Value
cell.Interior.Color = RGB(r, g, b) 'clr
Next cell
End Sub
|
|
|
| pus acum 1 an |
|