Sctipt - color

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