PowerPoint VBA에서 색상은 RGB(Red, Green, Blue농도)로 나타내지만
미리 정해진 색상들은 위와 같이 별도의 이름을 가지고 있습니다.
예를 들어 RGB(127,127,127) 은 회색인데 rgbGray 로 나타낼 수도 있습니다.
색상숫자는 외우기 어렵기 때문에 색상이름을 외워두면 간단히 써먹을 수 있습니다.
https://docs.microsoft.com/en-us/office/vba/api/excel.xlrgbcolor
이 색상이름을 미리 볼 수 있도록 만들어봤습니다.
You can preview, on a single page, all the RGB color constants(pre-defined color names) in Excel/PowerPoint VBA.
위 슬라이드를 만들어 내는 VBA코드입니다.
더보기
'Demonstrate/preview all PowerPoint RGB Color Constants available
'by konahn(at)naver.com
Option Explicit
Option Base 0
Public myColor As Variant
Public myColorName As Variant
Public Const Sorting As Boolean = False
Function InitColor()
myColor = Array(rgbAliceBlue, rgbAntiqueWhite, rgbAqua, rgbAquamarine, rgbAzure, rgbBeige, rgbBisque, rgbBlack, rgbBlanchedAlmond, rgbBlue, _
rgbBlueViolet, rgbBrown, rgbBurlyWood, rgbCadetBlue, rgbChartreuse, rgbCoral, rgbCornflowerBlue, rgbCornsilk, rgbCrimson, rgbDarkBlue, _
rgbDarkCyan, rgbDarkGoldenrod, rgbDarkGray, rgbDarkGreen, rgbDarkGrey, rgbDarkKhaki, rgbDarkMagenta, rgbDarkOliveGreen, rgbDarkOrange, _
rgbDarkOrchid, rgbDarkRed, rgbDarkSalmon, rgbDarkSeaGreen, rgbDarkSlateBlue, rgbDarkSlateGray, rgbDarkSlateGrey, rgbDarkTurquoise, _
rgbDarkViolet, rgbDeepPink, rgbDeepSkyBlue, rgbDimGray, rgbDimGrey, rgbDodgerBlue, rgbFireBrick, rgbFloralWhite, rgbForestGreen, _
rgbFuchsia, rgbGainsboro, rgbGhostWhite, rgbGold, rgbGoldenrod, rgbGray, rgbGreen, rgbGreenYellow, rgbGrey, rgbHoneydew, rgbHotPink, _
rgbIndianRed, rgbIndigo, rgbIvory, rgbKhaki, rgbLavender, rgbLavenderBlush, rgbLawnGreen, rgbLemonChiffon, rgbLightBlue, rgbLightCoral, _
rgbLightCyan, rgbLightGoldenrodYellow, rgbLightGray, rgbLightGreen, rgbLightGrey, rgbLightPink, rgbLightSalmon, rgbLightSeaGreen, _
rgbLightSkyBlue, rgbLightSlateGray, rgbLightSteelBlue, rgbLightYellow, rgbLime, rgbLimeGreen, rgbLinen, rgbMaroon, rgbMediumAquamarine, _
rgbMediumBlue, rgbMediumOrchid, rgbMediumPurple, rgbMediumSeaGreen, rgbMediumSlateBlue, rgbMediumSpringGreen, rgbMediumTurquoise, _
rgbMediumVioletRed, rgbMidnightBlue, rgbMintCream, rgbMistyRose, rgbMoccasin, rgbNavajoWhite, rgbNavy, rgbNavyBlue, rgbOldLace, _
rgbOlive, rgbOliveDrab, rgbOrange, rgbOrangeRed, rgbOrchid, rgbPaleGoldenrod, rgbPaleGreen, rgbPaleTurquoise, rgbPaleVioletRed, _
rgbPapayaWhip, rgbPeachPuff, rgbPeru, rgbPink, rgbPlum, rgbPowderBlue, rgbPurple, rgbRed, rgbRosyBrown, rgbRoyalBlue, rgbSalmon, _
rgbSandyBrown, rgbSeaGreen, rgbSeashell, rgbSienna, rgbSilver, rgbSkyBlue, rgbSlateBlue, rgbSlateGray, rgbSnow, rgbSpringGreen, _
rgbSteelBlue, rgbTan, rgbTeal, rgbThistle, rgbTomato, rgbTurquoise, rgbViolet, rgbWheat, rgbWhite, rgbWhiteSmoke, rgbYellow, _
rgbYellowGreen)
End Function
Function InitColorName()
myColorName = Array("rgbAliceBlue", "rgbAntiqueWhite", "rgbAqua", "rgbAquamarine", "rgbAzure", "rgbBeige", "rgbBisque", "rgbBlack", "rgbBlanchedAlmond", "rgbBlue", _
"rgbBlueViolet", "rgbBrown", "rgbBurlyWood", "rgbCadetBlue", "rgbChartreuse", "rgbCoral", "rgbCornflowerBlue", "rgbCornsilk", "rgbCrimson", "rgbDarkBlue", _
"rgbDarkCyan", "rgbDarkGoldenrod", "rgbDarkGray", "rgbDarkGreen", "rgbDarkGrey", "rgbDarkKhaki", "rgbDarkMagenta", "rgbDarkOliveGreen", "rgbDarkOrange", _
"rgbDarkOrchid", "rgbDarkRed", "rgbDarkSalmon", "rgbDarkSeaGreen", "rgbDarkSlateBlue", "rgbDarkSlateGray", "rgbDarkSlateGrey", "rgbDarkTurquoise", _
"rgbDarkViolet", "rgbDeepPink", "rgbDeepSkyBlue", "rgbDimGray", "rgbDimGrey", "rgbDodgerBlue", "rgbFireBrick", "rgbFloralWhite", "rgbForestGreen", _
"rgbFuchsia", "rgbGainsboro", "rgbGhostWhite", "rgbGold", "rgbGoldenrod", "rgbGray", "rgbGreen", "rgbGreenYellow", "rgbGrey", "rgbHoneydew", "rgbHotPink", _
"rgbIndianRed", "rgbIndigo", "rgbIvory", "rgbKhaki", "rgbLavender", "rgbLavenderBlush", "rgbLawnGreen", "rgbLemonChiffon", "rgbLightBlue", "rgbLightCoral", _
"rgbLightCyan", "rgbLightGoldenrodYellow", "rgbLightGray", "rgbLightGreen", "rgbLightGrey", "rgbLightPink", "rgbLightSalmon", "rgbLightSeaGreen", _
"rgbLightSkyBlue", "rgbLightSlateGray", "rgbLightSteelBlue", "rgbLightYellow", "rgbLime", "rgbLimeGreen", "rgbLinen", "rgbMaroon", "rgbMediumAquamarine", _
"rgbMediumBlue", "rgbMediumOrchid", "rgbMediumPurple", "rgbMediumSeaGreen", "rgbMediumSlateBlue", "rgbMediumSpringGreen", "rgbMediumTurquoise", _
"rgbMediumVioletRed", "rgbMidnightBlue", "rgbMintCream", "rgbMistyRose", "rgbMoccasin", "rgbNavajoWhite", "rgbNavy", "rgbNavyBlue", "rgbOldLace", _
"rgbOlive", "rgbOliveDrab", "rgbOrange", "rgbOrangeRed", "rgbOrchid", "rgbPaleGoldenrod", "rgbPaleGreen", "rgbPaleTurquoise", "rgbPaleVioletRed", _
"rgbPapayaWhip", "rgbPeachPuff", "rgbPeru", "rgbPink", "rgbPlum", "rgbPowderBlue", "rgbPurple", "rgbRed", "rgbRosyBrown", "rgbRoyalBlue", "rgbSalmon", _
"rgbSandyBrown", "rgbSeaGreen", "rgbSeashell", "rgbSienna", "rgbSilver", "rgbSkyBlue", "rgbSlateBlue", "rgbSlateGray", "rgbSnow", "rgbSpringGreen", _
"rgbSteelBlue", "rgbTan", "rgbTeal", "rgbThistle", "rgbTomato", "rgbTurquoise", "rgbViolet", "rgbWheat", "rgbWhite", "rgbWhiteSmoke", "rgbYellow", _
"rgbYellowGreen")
End Function
Sub Main() 'Main sub routine
Dim sld As Slide
Dim myLayout As CustomLayout
Dim shp As Shape, shpGo As Shape
Dim eft As Effect
Dim i As Integer, s As Integer
Dim SW As Single, SH As Single
Dim x!, y!, w!, h!, m1!, m2!, cols As Integer
'EraseSlidesExcept1st
InitColor
InitColorName
If Sorting Then
Quicksort2 myColor, myColorName, LBound(myColor), UBound(myColor)
End If
Randomize
With ActivePresentation.PageSetup
SW = .SlideWidth
SH = .SlideHeight
End With
'Set myLayout = ActivePresentation.Slides(1).CustomLayout
Set sld = ActivePresentation.Slides.add(2, ppLayoutBlank)
cols = 15 '컬럼수
m1 = 3 '네모 사이 여백
m2 = 10 '슬라이드 여백
w = (SW - m2 * 2) / cols - m1 * 2
h = (SH - m2 * 2) / Int((UBound(myColor) + cols - 1) / cols) - m1 * 2
For i = LBound(myColor) To UBound(myColor)
x = m2 + (i Mod cols) * (w + m1 * 2) + m1
y = m2 + Int(i / cols) * (h + m1 * 2) + m1
Set shp = sld.Shapes.AddShape(msoShapeRoundedRectangle, x, y, w, h)
shp.Fill.ForeColor.RGB = myColor(i)
shp.Line.Visible = msoFalse
shp.TextFrame.TextRange.Font.Size = 10
shp.TextFrame.TextRange.Font.Color.RGB = rgbWhite
shp.TextFrame.TextRange.Font.Shadow = msoTrue
shp.TextFrame.TextRange.Text = Mid(myColorName(i), 4)
addlines shp.TextFrame.TextRange
shp.TextFrame.WordWrap = msoFalse
shp.Name = "shp" & i
shp.ActionSettings(ppMouseOver).Action = ppActionRunMacro
shp.ActionSettings(ppMouseOver).Run = "AddMyColor"
shp.ActionSettings(ppMouseClick).Action = ppActionRunMacro
shp.ActionSettings(ppMouseClick).Run = "CopyColorText1"
Next i
'the name of the color over which the mouse is
Set shp = sld.Shapes.AddShape(msoShapeRoundedRectangle, SW - 300 - m2, SH - 30 - m2, 300, 30)
shp.Fill.Visible = msoTrue
shp.Line.Weight = 1
shp.Line.ForeColor.RGB = rgbGray
shp.Name = "Color Name"
shp.TextFrame.TextRange.Font.Color.RGB = rgbBlack
shp.TextFrame.TextRange.Font.Shadow = msoTrue
shp.TextFrame.TextRange.Font.Size = 15
shp.TextFrame.TextRange.Text = "Move the mouse over the color to see"
shp.TextFrame.WordWrap = msoFalse
End Sub
Function addlines(ByRef tr As TextRange)
Dim i As Integer
Dim c As String
For i = Len(tr) To 1 Step -1
c = tr.Characters(i, 1).Text
If UCase(c) = c And i > 1 Then
tr.Characters(i, 1).InsertBefore (vbCr)
End If
Next i
End Function
Function AddMyColor(shp As Shape)
Dim i As Integer
Dim sld As Slide
Dim idx As Integer
Dim eft As Effect
If IsEmpty(myColor) Then InitColor
If IsEmpty(myColorName) Then InitColorName
Set sld = ActivePresentation.Slides(2)
idx = Mid(shp.Name, 4)
'change color name
sld.Shapes("Color Name").TextFrame.TextRange.Text = myColorName(idx) & " (" & myColor(idx) & ")"
sld.Shapes("Color Name").Fill.ForeColor.RGB = myColor(idx)
End Function
Function CopyColorText1(shp As Shape)
Dim idx As Integer
If IsEmpty(myColor) Then InitColor
If IsEmpty(myColorName) Then InitColorName
idx = Mid(shp.Name, 4) 'ex) "shp120" -> 120
'to use this, add a reference to 'MSForm 2.0 Library' by clicking [Tools-Reference] in VBE
Dim DataObj As New MSForms.DataObject
'Copy the effect name into Clipboard
DataObj.SetText myColorName(idx)
DataObj.PutInClipboard
MsgBox myColorName(idx) & " is copied into Clipboard"
Set DataObj = Nothing
End Function
Function CopyColorText(shp As Shape)
'to use this, add a reference to 'MSForm 2.0 Library' by clicking [Tools-Reference] in VBE
Dim DataObj As New MSForms.DataObject
'Copy the effect name into Clipboard
DataObj.SetText Left(shp.TextFrame.TextRange.Text, InStr(1, shp.TextFrame.TextRange.Text, "(") - 1)
DataObj.PutInClipboard
MsgBox shp.TextFrame.TextRange.Text & " is copied into Clipboard"
Set DataObj = Nothing
End Function
'erase all slides from #2
Function EraseSlidesExcept1st()
Dim i As Integer
For i = ActivePresentation.Slides.Count To 2 Step -1
ActivePresentation.Slides(i).Delete
Next i
End Function
'remove all animations including triggers
Function Zap_Animations()
Dim oeff As Effect
Dim i As Integer
Dim t As Integer
Dim osld As Slide
For Each osld In ActivePresentation.Slides
'Remove normal animations
For i = osld.TimeLine.MainSequence.Count To 1 Step -1
osld.TimeLine.MainSequence(i).Delete
Next i
'Remove triggers
For i = osld.TimeLine.InteractiveSequences.Count To 1 Step -1
For t = osld.TimeLine.InteractiveSequences(i).Count To 1 Step -1
osld.TimeLine.InteractiveSequences(i).Item(t).Delete
Next t
Next i
Next osld
End Function
'original version: https://wellsr.com/vba/2018/excel/vba-quicksort-macro-to-sort-arrays-fast/
Function Quicksort2(vArray As Variant, vArray2 As Variant, arrLbound As Long, arrUbound As Long)
'Sorts a one-dimensional VBA array from smallest to largest
'using a very fast quicksort algorithm variant.
Dim pivotVal As Variant
Dim vSwap As Variant
Dim tmpLow As Long
Dim tmpHi As Long
tmpLow = arrLbound
tmpHi = arrUbound
pivotVal = vArray((arrLbound + arrUbound) \ 2)
While (tmpLow <= tmpHi) 'divide
While (vArray(tmpLow) < pivotVal And tmpLow < arrUbound)
tmpLow = tmpLow + 1
Wend
While (pivotVal < vArray(tmpHi) And tmpHi > arrLbound)
tmpHi = tmpHi - 1
Wend
If (tmpLow <= tmpHi) Then
vSwap = vArray(tmpLow)
vArray(tmpLow) = vArray(tmpHi)
vArray(tmpHi) = vSwap
'//swap the second array
vSwap = vArray2(tmpLow)
vArray2(tmpLow) = vArray2(tmpHi)
vArray2(tmpHi) = vSwap
'//swap
tmpLow = tmpLow + 1
tmpHi = tmpHi - 1
End If
Wend
If (arrLbound < tmpHi) Then Quicksort2 vArray, vArray2, arrLbound, tmpHi 'conquer
If (tmpLow < arrUbound) Then Quicksort2 vArray, vArray2, tmpLow, arrUbound 'conquer
End Function
아래 첨부파일을 매크로 허용해서 열고 슬라이드쇼를 실행하면
위 처럼 색상 미리 보기를 할 수 있고
클릭해서 클립보드에 색상 이름을 복사할 수도 있습니다.
4:3버전(구버전)
16:9버전(신버전)
'PPT+VBA' 카테고리의 다른 글
그림효과 복사 일괄적용 (0) | 2021.09.12 |
---|---|
파워포인트 파일을 저장 후 다시 열 때 읽기전용 (Read Only) 로 바뀌는 경우 (0) | 2021.09.08 |
슬라이드 번호를 특정 페이지부터 시작 (6) | 2021.08.09 |
이동경로 애니메이션의 VML 기초 문법 및 수정 방법 (0) | 2021.08.02 |
pptx의 내용에 문제가 있습니다. 프리젠테이션 복구가 시도될 수 있습니다. (0) | 2021.06.26 |
사진 일괄 삽입 매크로 (3) | 2021.06.08 |
텍스트상자와 배경도형 정렬 (0) | 2021.05.31 |
ppt를 그림 프리젠테이션으로 저장 (1) | 2021.05.12 |
최근댓글