본문 바로가기
IT일반/소소한 팁

[파워포인트] 브랜드 컬러에 맞게 도형과 표 색상 일괄 변경하기

by 우공80 2023. 6. 21.
728x90

브랜드 컬러 일괄변경 매크로

오늘 전사 공지 게시판에 회사의 브랜드 컬러가 변경되니, CI/BI 가이드 참고하라는 글이 있었습니다. PPT를 작성할 때, 회사의 브랜드 컬러에 맞추는 것이 여간 귀찮은 일이 아닌데요.
오늘 문득 이걸 일괄 변경하는 방법이 없을까 하여 ChatGPT의 도움을 받아 매크로를 작성해 보았습니다.

 

이 매크로는 두 개 모듈로 이루어져 있습니다. 

  1. ChangeSlideColor는 전체 슬라이드의 도형과 표에 대해 변경을 수행합니다.
  2. ChangeSelectedShapeColor는 선택한 도형과 표에 대해 변경을 수행합니다.
  3. 색상에 따라 도형의 텍스트 색상도 변경 가능합니다.

코드에 브랜드 컬러를 사전에 정의하고(targetColors), 매크로를 실행하면, 슬라이드 전체 혹은 선택한 도형과 표의 현재 컬러(currentColor)와 정의된 브랜드 컬러(targetColors)를 비교해서 가장 가까운 색(closestColor)으로 변경합니다. 

 

이 매크로는 다음과 같은 한계가 있습니다.

  1. 그라데이션이 적용된 도형은 변경되지 않습니다.
  2. 그룹화되어 있는 경우 변경되지 않습니다.
  3. 선, 테두리 색은 변경되지 않습니다. 
  4. 미적으로 마음에 들지 않을 수 있습니다.

사용방법은 다음과 같습니다. 

우선 어떻게 변하는지 보여드리기 위해 여러 가지 색상의 사각형을 만들었습니다.

1. 개발 도구 탭 >> Visual Basic을 실행시킵니다

※ 혹시 개발 도구 탭이 보이지 않는다면, 아래 글을 참고합니다.

2023.03.11 - [IT일반/소소한 팁] - [파워포인트] 개발 도구 - 매크로 메뉴 활성화하는 방법

 

[파워포인트] 개발 도구 - 매크로 메뉴 활성화하는 방법

매크로 기능을 사용하고 싶은데, 매크로 기능이 들어있는 "개발 도구" 탭이 보이지 않을 때는 아래와 같은 방법으로 도구를 활성화합니다. 메뉴 상단 : 파일 -> 옵션 리본 사용자 지정 -> 개발 도

woogong80.tistory.com

2. VBAProject에 우클릭 >> 삽입 >> 모듈 클릭합니다.

3. 이 글 가장 하단에 있는 코드를 복사해서 붙여 넣습니다. (이 창은 이제 닫아도 됩니다.)

 

4. 개발도구 >> 매크로를 실행합니다.

5-1. 전체 슬라이드를 변경하려면 ChangeSlideColor를 선택하고 실행합니다.

5-2. 선택한 도형만 변경하려면 ChangeSelectedShapeColor를 선택하고 실행합니다.
아래 그림처럼 반드시 도형이 선택된 상태에서 실행해야 합니다. (선택이 없으면 오류 발생)

6. 짜잔~~ 브랜드 컬러에 맞는 색상으로 변경되었습니다. 

글자색도 정해진 대로 배경에 따라 변경되었습니다.

※ 매크로 코드 (복사해서 붙여 넣으세요)

아래 코드에서 ★로 표시된 아래에 설정하고자 하는 브랜드 컬러를 정해주면 됩니다.

Sub ChangeSlideColor()
    Dim currentSlide As Slide
    Dim selectedShape As Shape
    Dim targetColors() As Variant
    Dim currentColor As String
    Dim isTargetColor As Boolean
    Dim closestColor As String
    ' Define the target colors ★★브랜드 컬러를 Array에 설정★★
    targetColors = Array("#079b31", "#FFFFFF", "#000000", "#28ff9e", "#8dcc30", "#D1E92D4", "#5de23f", "#F1F1F1")
    ' Loop through each slide in the presentation
    For Each currentSlide In ActivePresentation.Slides
        ' Loop through each shape on the slide
        For Each selectedShape In currentSlide.Shapes
            ' Check if the shape is a table
            If selectedShape.HasTable Then
                ' Handle color change for table cells
                Dim table As table
                Set table = selectedShape.table
                ' Loop through each cell in the table
                Dim row As Integer, column As Integer
                For row = 1 To table.Rows.Count
                    For column = 1 To table.Columns.Count
                        currentColor = RGBToString(table.Cell(row, column).Shape.Fill.ForeColor.rgb)
                        isTargetColor = False
                        Dim i As Integer
                        For i = 0 To UBound(targetColors)
                            If currentColor = targetColors(i) Then
                                isTargetColor = True
                                Exit For
                            End If
                        Next i
                        ' Change the cell's color to the closest target color
                        If Not isTargetColor Then
                            closestColor = GetClosestColor(currentColor, targetColors)
                            table.Cell(row, column).Shape.Fill.ForeColor.rgb = RGBFromString(closestColor)
                            ' Change text color to #FFFFFF for specific colors
                            Select Case closestColor '★★글자색을 흰색으로 변경할 브랜드 컬러★★                            	
                                Case "#079b31", "#FFFFFF", "#28ff9e", "#8dcc30"
                                    table.Cell(row, column).Shape.TextFrame.TextRange.Font.Color.rgb = RGBFromString("#FFFFFF")
                            End Select
                        End If
                    Next column
                Next row
            Else
                ' Handle color change for regular shapes
                currentColor = RGBToString(selectedShape.Fill.ForeColor.rgb)
                isTargetColor = False
                Dim j As Integer
                For j = 0 To UBound(targetColors)
                    If currentColor = targetColors(j) Then
                        isTargetColor = True
                        Exit For
                    End If
                Next
                ' Change the shape's color to the closest target color
                If Not isTargetColor Then
                    closestColor = GetClosestColor(currentColor, targetColors)
                    selectedShape.Fill.ForeColor.rgb = RGBFromString(closestColor)
                    ' Change text color to #FFFFFF for specific colors 
                    Select Case closestColor '★★글자색을 흰색으로 변경할 브랜드 컬러★★
                        Case "#079b31", "#FFFFFF", "#28ff9e", "#8dcc30"
                            selectedShape.TextFrame.TextRange.Font.Color.rgb = RGBFromString("#FFFFFF")
                    End Select
                End If
            End If
        Next selectedShape
    Next currentSlide
End Sub
 
Sub ChangeSelectedShapeColor()
    Dim selectedShape As Shape
    Dim targetColors() As Variant
    Dim currentColor As String
    Dim isTargetColor As Boolean
    Dim closestColor As String
    ' Define the target colors ★★브랜드 컬러를 Array에 설정★★
    targetColors = Array("#079b31", "#FFFFFF", "#000000", "#28ff9e", "#8dcc30", "#D1E92D4", "#5de23f", "#F1F1F1")
    ' Loop through each selected shape on the active slide
    For Each selectedShape In ActiveWindow.Selection.ShapeRange
        ' Check if the shape is a table
        If selectedShape.HasTable Then
            ' Handle color change for table cells
            Dim table As table
            Set table = selectedShape.table
            ' Loop through each cell in the table
            Dim row As Integer, column As Integer
            For row = 1 To table.Rows.Count
                For column = 1 To table.Columns.Count
                    currentColor = RGBToString(table.Cell(row, column).Shape.Fill.ForeColor.rgb)
                    isTargetColor = False
                    Dim i As Integer
                    For i = 0 To UBound(targetColors)
                        If currentColor = targetColors(i) Then
                            isTargetColor = True
                           Exit For
                        End If
                    Next i
                    ' Change the cell's color to the closest target color
                    If Not isTargetColor Then
                        closestColor = GetClosestColor(currentColor, targetColors)
                        table.Cell(row, column).Shape.Fill.ForeColor.rgb = RGBFromString(closestColor)
                        ' Change text color to #FFFFFF for specific colors
                        Select Case closestColor '★★글자색을 흰색으로 변경할 브랜드 컬러★★
                            Case "#079b31", "#FFFFFF", "#28ff9e", "#8dcc30"
                                table.Cell(row, column).Shape.TextFrame.TextRange.Font.Color.rgb = RGBFromString("#FFFFFF")
                        End Select
                    End If
                Next column
            Next row
        Else
            ' Handle color change for regular shapes
            currentColor = RGBToString(selectedShape.Fill.ForeColor.rgb)
            isTargetColor = False
            Dim j As Integer
            For j = 0 To UBound(targetColors)
                If currentColor = targetColors(j) Then
                    isTargetColor = True
                    Exit For
                End If
            Next j
            ' Change the shape's color to the closest target color
            If Not isTargetColor Then
                closestColor = GetClosestColor(currentColor, targetColors)
                selectedShape.Fill.ForeColor.rgb = RGBFromString(closestColor)
                ' Change text color to #FFFFFF for specific colors
                Select Case closestColor '★★글자색을 흰색으로 변경할 브랜드 컬러★★
                    Case "#079b31", "#FFFFFF", "#28ff9e", "#8dcc30"
                        selectedShape.TextFrame.TextRange.Font.Color.rgb = RGBFromString("#FFFFFF")
                End Select
            End If
       End If
    Next selectedShape
End Sub

Function RGBToString(ByVal rgb As Long) As String
    ' Convert an RGB color value to a string representation
    Dim red As Integer, green As Integer, blue As Integer
    red = rgb Mod 256
    green = rgb \ 256 Mod 256
    blue = rgb \ 65536 Mod 256
    RGBToString = "#" & Right("00" & Hex(red), 2) & Right("00" & Hex(green), 2) & Right("00" & Hex(blue), 2)
End Function
 
Function RGBFromString(ByVal rgbString As String) As Long
    ' Convert an RGB color string to a long value
    Dim red As Integer, green As Integer, blue As Integer
    red = Val("&H" & Mid(rgbString, 2, 2))
    green = Val("&H" & Mid(rgbString, 4, 2))
    blue = Val("&H" & Mid(rgbString, 6, 2))
    RGBFromString = rgb(red, green, blue)
End Function

Function GetClosestColor(ByVal currentColor As String, ByRef targetColors() As Variant) As String
    ' Find the closest color in the targetColors array to the currentColor
    Dim closestColor As String
    Dim minDistance As Double
    minDistance = 1000000 ' Initialize with a large value
 
    Dim i As Integer
    For i = 0 To UBound(targetColors)
        Dim distance As Double
        distance = ColorDistance(currentColor, targetColors(i))
        If distance < minDistance Then
            minDistance = distance
            closestColor = targetColors(i)
        End If
    Next i
  
    GetClosestColor = closestColor
End Function
 
Function ColorDistance(ByVal color1 As String, ByVal color2 As String) As Double
    ' Calculate the Euclidean distance between two colors
 
    Dim red1 As Integer, green1 As Integer, blue1 As Integer
    Dim red2 As Integer, green2 As Integer, blue2 As Integer
    red1 = Val("&H" & Mid(color1, 2, 2))
    green1 = Val("&H" & Mid(color1, 4, 2))
    blue1 = Val("&H" & Mid(color1, 6, 2))
    red2 = Val("&H" & Mid(color2, 2, 2))
    green2 = Val("&H" & Mid(color2, 4, 2))
    blue2 = Val("&H" & Mid(color2, 6, 2))
       
    ColorDistance = Sqr((red2 - red1) ^ 2 + (green2 - green1) ^ 2 + (blue2 - blue1) ^ 2)
End Function

 

 

※ 다른 유용한 매크로도 있어요~~!!!

2023.03.12 - [IT일반/소소한 팁] - [파워포인트] 매크로를 이용하여 슬라이드 노트를 텍스트 파일로 일괄저장하는 방법

 

[파워포인트] 매크로를 이용하여 슬라이드 노트를 텍스트 파일로 일괄저장하는 방법

PPT 발표를 준비하면서 PPT의 슬라이드 노트에 스크립트를 작성하는 경우가 많은데요. 슬라이드 노트를 출력하면 페이지수가 길어지기 때문에 본문 없이 텍스트만 저장할 수 없을까 고민이 되었

woogong80.tistory.com

2023.03.11 - [IT일반/소소한 팁] - [파워포인트] 매크로를 이용한 슬라이드 노트 일괄 삭제 방법

 

[파워포인트] 매크로를 이용한 슬라이드 노트 일괄 삭제 방법

PPT자료를 만들 때, 슬라이드 노트를 작성하는 경우가 많습니다. 하지만, 작성한 PPT자료를 공유해야 할 때는 슬라이드는 삭제하고 공유하는 것이 좋습니다. PDF로 공유하면 슬라이드 노트를 삭제

woogong80.tistory.com

 

728x90

댓글