Sctipt - color #
What is it? #
Useful functions for handling color.
RGB_color #
Displays RGB values of the selected shape via UserForm.
→ Refer to the .PPAM file for the userForm
code.
Color_palette #
Creates a color palette in the slide master - newly added feature.
Sub pal2()
Dim mySlideMaster As Master
Dim left As Integer
Dim top As Integer
Dim size As Integer
Dim idx As Integer
Dim rgb1 As Long
Dim rgb2 As Long
Dim hexcolor As String
Dim colred As Integer
Dim colgreen As Integer
Dim colblue As Integer
Dim newcol As String
Dim pagenum As Integer
On Error GoTo Err_Check
Set mySlideMaster = Application.ActivePresentation.slideMaster
If MsgBox("do you wanna set default?", vbYesNo) = vbNo Then
If MsgBox("do you wanna use HEX color data?", vbYesNo) = vbYes Then
On Error GoTo Err_Check
hexcolor = InputBox("your hex color")
newcol = HexToRGB(hexcolor)
colred = Replace(Split(newcol, ",")(0), " ", "")
colgreen = Replace(Split(newcol, ",")(1), " ", "")
colblue = Replace(Split(newcol, ",")(2), " ", "")
idx = InputBox("index")
Else
On Error GoTo Err_Check
colred = InputBox("type R")
colgreen = InputBox("type G")
colblue = InputBox("type B")
idx = InputBox("index")
If colred < 0 Or colgreen < 0 Or colblue < 0 Or idx <= 0 Then
MsgBox "Invalid input values", vbCritical
GoTo Err_Check2
End If
End If
top = 0
left = -25
size = 20
With mySlideMaster.Shapes.AddShape(Type:=msoShapeRectangle, left:=left, top:=topcal(idx, size), width:=size, height:=size)
.Fill.ForeColor.RGB = RGB(colred, colgreen, colblue)
.line.Visible = msoFalse
End With
Else
rgb1 = RGB(0, 63, 104)
rgb2 = RGB(237, 116, 35)
For x = 1 To 4
counter = counter + 1
With mySlideMaster.Shapes.AddShape(Type:=msoShapeRectangle, left:=-25, top:=((x - 1) * 20) + (ConvertCmToPoint(0.3) * (x - 1)), width:=20, height:=20)
If x = 1 Then
.Fill.ForeColor.RGB = rgb1
ElseIf x = 2 Then
.Fill.ForeColor.RGB = rgb2
Else
.Fill.ForeColor.RGB = RGB(0, 0, 0)
End If
.line.Visible = msoFalse
End With
Next x
End If
Exit Sub
Err_Check:
If Err.Number <> 0 Then
MsgBox "오류번호 : " & Err.Number & vbCr & "오류내용 : " & Err.Description, vbCritical, "오류"
End If
Exit Sub
Err_Check2:
MsgBox "you have wrong input value", vbCritical, "잘못된 입력"
Exit Sub
End Sub
Function topcal(idx As Integer, size As Integer)
If idx = 1 Then
topcal = 0
Else
topcal = ((idx - 1) * size) + (ConvertCmToPoint(0.3) * (idx - 1))
End If
End Function
Function ConvertPointToCm(ByVal pnt As Double) As Double
ConvertPointToCm = pnt * 0.03527778
End Function
Function ConvertCmToPoint(ByVal cm As Double) As Double
ConvertCmToPoint = cm * 28.34646
End Function
Function HexToRGB(hexcolor As String) As String
Dim r As Integer
Dim G As Integer
Dim B As Integer
Dim newrgbcolor As String
On Error GoTo Err_Check
hexcolor = Replace(hexcolor, "#", "")
hexcolor = Right$("000000" & hexcolor, 6)
r = val("&H" & Mid(hexcolor, 1, 2))
G = val("&H" & Mid(hexcolor, 3, 2))
B = val("&H" & Mid(hexcolor, 5, 2))
newrgbcolor = r & ", " & G & ", " & B
Debug.Print newrgbcolor
HexToRGB = newrgbcolor
Exit Function
Err_Check:
If Err.Number <> 0 Then
MsgBox "오류번호 : " & Err.Number & vbCr & "오류내용 : " & Err.Description, vbCritical, "오류"
End If
Exit Function
End Function