Decription: This code will show and convert, if needed, RGB values or the selected shape.
Date: 2010-05-04 Author: John
Code:
Option Explicit
Sub convertRGB()
Dim s As Shape
Dim rVal1 As Long, gVal1 As Long, bVal1 As Long
Dim rValPerc1 As Long, gValPerc1 As Long, bValPerc1 As Long
Dim rVal2 As Variant, gVal2 As Variant, bVal2 As Variant
Dim rValPerc2 As Long, gValPerc2 As Long, bValPerc2 As Long
Dim retval As Long
Set s = ActiveShape
If s.Fill.Type = cdrUniformFill Then
If s.Fill.UniformColor.IsCMYK Then
s.Fill.UniformColor.ConvertToRGB
End If
rVal1 = s.Fill.UniformColor.RGBRed
gVal1 = s.Fill.UniformColor.RGBGreen
bVal1 = s.Fill.UniformColor.RGBBlue
rValPerc1 = (rVal1 / 255) * 100
gValPerc1 = (gVal1 / 255) * 100
bValPerc1 = (bVal1 / 255) * 100
retval = MsgBox( _
"R= " & rVal1 & " %R = " & rValPerc1 & vbNewLine & _
"G= " & gVal1 & " %G = " & gValPerc1 & vbNewLine & _
"B= " & bVal1 & " %B = " & bValPerc1, vbOKCancel, "Click ok to enter new PERCENT values, Cancel to quit.")
End If
If retval = 2 Then
Exit Sub
End If
If retval = 1 Then
rValPerc2 = InputBox("You current R value is " & rVal1 & " and the %R is " & rValPerc1, "Enter a New R Percentage", rValPerc1)
gValPerc2 = InputBox("You current G value is " & gVal1 & " and the %G is " & gValPerc1, "Enter a New G Percentage", gValPerc1)
bValPerc2 = InputBox("You current B value is " & bVal1 & " and the %B is " & bValPerc1, "Enter a New B Percentage", bValPerc1)
End If
If IsNumeric(rValPerc2) And IsNumeric(gValPerc2) And IsNumeric(bValPerc2) Then
If rValPerc2 <= 100 And rValPerc2 >= 0 Then
rVal2 = (rValPerc2 * 255) / 100
s.Fill.UniformColor.RGBRed = rVal2
Else
GoTo 1001
End If
If gValPerc2 <= 100 And gValPerc2 >= 0 Then
gVal2 = (gValPerc2 * 255) / 100
s.Fill.UniformColor.RGBGreen = gVal2
Else
GoTo 1001
End If
If bValPerc2 <= 100 And bValPerc2 >= 0 Then
bVal2 = (bValPerc2 * 255) / 100
s.Fill.UniformColor.RGBBlue = bVal2
Else
GoTo 1001
End If
End If
If 1 = 100 Then
1001:
MsgBox "You entered an incorrect precent value."
Exit Sub
End If
End Sub
|
MyAccount
