실행화면 캡쳐영상:

 

 

기본 화면:

위와 같은 화면 구성입니다.

인쇄해서 단어 빨리 찾기 게임 등을 할 때 유용합니다.

슬라이드 크기는 A4로 설정되어 있습니다.

 

먼저 대상 슬라이드를 선택하여야 합니다. 

Edit Word List를 눌러서 엑셀 파일을 편집하고 Load List/ Scatter Words 를 누르고 해당 엑셀 파일을 불러오면 됩니다.

엑셀 파일은 아래와 같이 WordReference 엑셀파일과 같이 B2셀부터 아래에 단어목록이 있으면 됩니다.

 

50개 이상이면 단어 위치가 중복되지 않도록 하는 과정에서 

무한 대기 현상이 일어날 수 있으니 주의하세요.

20~40개 정도 이내가 적당합니다.

 

 

미리 단어의 Font 크기를 조절할 수 있습니다. 폰트크기를 입력할 수도 있고 8,10,12,14,16 중에서 고를 수도 있습니다.

Harder 에 체크하면 난이도가 어렵도록 철자가 비슷한 단어가 한 개씩 추가되어 단어개수가 두 배가 됩니다.

배경Layout 을 선택하면 슬라이드 마스터의 커스텀레이아웃 배경을 바꿔줍니다.

현재 12개 이상의 배경 레이아웃이 들어 있는 상태입니다.

사진들의 출처는 pixabay.com 입니다. (Pictures are copied from http://pixabay.com)

슬라이드마스터의 여러가지 배경레이아웃들:

Layout 1번은 빈 배경입니다. 9번이 기본 배경이고 1번~13 혹은 임의의 숫자를 입력할 수 있습니다.

 

Add lines 은 가로세로 선을 추가하고

Add Boxes 는 바둑판 모양 네모를 추가합니다.

 

Add Triangles는 랜덤한 직각 삼각형을 추가하고

Add Arcs 는 행성처럼 치우쳐진 원도형을 추가합니다.

AddOrbits 는 가운데에 궤도 도형을 추가하고

AddBlockArc 는 뒤에 부채꼴모양 원을 추가합니다.

Delete Shapes는 모든 도형을 제거해주고

Delete Words 는 모든 단어를 제거합니다.

 

위와 같은 리본 도형을 추가하려면 아래와 같은  CustomUI.XML 설정을 이용했습니다.

더보기
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" onLoad="onLoad">
	<ribbon startFromScratch="false">
		<tabs>
			<tab id="WordScatter" label="WordScatter">
				<group id="Group1" label="About">
					<button id="Button1" label="About" imageMso="Info" size="large" onAction="About" screentip="대하여..." />
				</group>
				<group id="Group2" label="Open">
					<button id="Button2" label="Edit Word List" imageMso="TableDrawTable" size="large" onAction="OpenEdit" screentip="엑셀 단어목록 편집(B2부터 아래로)" />
				</group>				    
				<group id="Group3" label="Create">
					<button id="Button3" label="Load List / Scatter Words" imageMso="UpgradePresentation" size="large" onAction="Scatter" screentip="엑셀파일을 불러와서 단어를 화면에 뿌립니다." />
                </group>
                <group id="Group4" label="Layout option">    			
					<comboBox id="FontSize" sizeString="WW.W" maxLength="5" label="Font size"  getText="Font_getText" onChange="FontSize" screentip="글자크기">
					<item id="item1" label="8" />
					<item id="item2" label="10" />					
					<item id="item3" label="12" />					
					<item id="item4" label="14" />
                    <item id="item5" label="16" />
					</comboBox>
			    
					<checkBox id="Hard" label ="Harder" onAction="HardEasy" screentip="난이도 조절" description="Add confusing words" />

                    <comboBox id="Layout" sizeString="WW" maxLength="2" label="Layout"  getText="Layout_getText" onChange="LayoutChange" screentip="배경 선택">
					<item id="litem1" label="1" />
					<item id="litem2" label="2" />					
					<item id="litem3" label="3" />					
					<item id="litem4" label="4" />
                    <item id="litem5" label="5" />
					<item id="litem6" label="6" />
					<item id="litem7" label="7" />					
					<item id="litem8" label="8" />					
					<item id="litem9" label="9" />
                    <item id="litem10" label="10" />
                    <item id="litem11" label="11" />
                    <item id="litem12" label="12" />
                    <item id="litem13" label="13" />                                              
					</comboBox>
                </group>
                <group id="Group5" label="Background Shapes">
                    <button id="Button4" label="Add Lines"  imageMso="BlackAndWhiteDontShow" size="large" onAction="DrawLines" screentip="가로세로 직선 추가" />
					<button id="Button5" label="Add Boxes"  imageMso="ViewDisplayInHighContrast" size="large" onAction="DrawBoxes" screentip="네모 배경 추가" />
                    <button id="Button6" label="Add Triangles"  imageMso="ShapeIsoscelesTriangle" size="large" onAction="DrawTriangles" screentip="세모 배경 추가" />
					<button id="Button7" label="Add Arcs"  imageMso="ShapeOval" size="large" onAction="DrawArcs" screentip="원호 배경 추가" />	
                    <button id="Button8" label="Add Orbits"  imageMso="ShapeDonut" size="large" onAction="DrawOrbits" screentip="궤도 배경 추가" />
					<button id="Button9" label="Add BlockArcs"  imageMso="Chart3DPieChart" size="large" onAction="DrawBlockArcs" screentip="부채꼴 배경 추가" />										
				</group>				    
				<group id="Group6" label="Remove">
				    <button id="Button10" label="Delete All Shapes"  imageMso="ReviewDeleteComment" size="large" onAction="delGroups" screentip="모든 도형 삭제" />
					<button id="Button11" label="Delete All Words"  imageMso="CellsDelete" size="large" onAction="delWords" screentip="모든 단어 삭제" />
				</group>

			</tab>
		</tabs>
	</ribbon>
</customUI>

 

사용된 VBA코드는 아래와 같습니다.

더보기
'엑셀 단어 목록을 읽어와서 화면의 랜덤 위치에 뿌려줌.
Option Explicit
'Public WSUI As IRibbonUI
Public Hard As Boolean 'True/False - True 이면 비슷한 단어 출력
Public FontSZ As String '글자 크기
Public SW As Single, SH As Single   '슬라이드 크기(A4)
Const w As Single = 80  '텍스트박스 크기
Const h As Single = 15


Sub WordScatter()
    Dim control As IRibbonControl
    Scatter (control)
End Sub

Sub OpenEdit(control As IRibbonControl)
    
    Dim xlsApp As Excel.Application
    Dim xlsBook As Excel.Workbook
    Dim sht As Excel.Worksheet
    Dim fname As String
    
    MsgBox "엑셀파일을 선택하고" & vbNewLine & "B열2번째 B2셀부터 아래로 단어를 입력하고 저장하세요."
    
    With Application.FileDialog(msoFileDialogOpen)
        .InitialFileName = ActivePresentation.Path & "\"
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Choose word list", "*.xls?"
        If .Show Then fname = .SelectedItems(1)
    End With
    
    On Error GoTo Oops
    
    Set xlsApp = New Excel.Application
    Set xlsBook = xlsApp.Workbooks.Open(fname)
    'Set sht = xlsBook.Worksheets(1)
    xlsApp.Visible = True
    
Oops:

End Sub

Sub Scatter(control As IRibbonControl)
    
    Dim xlsApp As Excel.Application
    Dim xlsBook As Excel.Workbook
    Dim sht As Excel.Worksheet
    Dim lastRow As Long
    Dim fname As String
    Dim r As Excel.Range

    Dim x As Single, y As Single
    Dim rr As Integer
    Dim sld As Slide, shp As Shape
    
    Set sld = ActiveWindow.View.Slide
    If existShp(sld, "Word_*") Then
        If MsgBox("기존 단어들을 지울까요?", vbOKCancel) = vbOK Then Call delWords(control)
    End If
    
    Randomize
    
    With Application.FileDialog(msoFileDialogOpen)
        .InitialFileName = ActivePresentation.Path & "\"
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Choose word list", "*.xls?"
        If .Show Then fname = .SelectedItems(1)
    End With
    
    On Error GoTo Oops
    
    Set xlsApp = New Excel.Application
    Set xlsBook = xlsApp.Workbooks.Open(fname)
    Set sht = xlsBook.Worksheets(1)
    lastRow = sht.Cells(sht.Rows.Count, "B").End(Excel.xlUp).Row
    If lastRow <= 1 Then MsgBox "단어목록이 없습니다.": Exit Sub
    If lastRow > 100 Then If MsgBox("너무 많은 단어목록은 '응답없음'을 초래합니다." & _
        vbNewLine & "계속할까요?", vbYesNo) = vbNo Then Exit Sub
        
    With ActivePresentation.PageSetup
        SH = .SlideHeight
        SW = .SlideWidth
    End With
    

    For Each r In sht.Range("B2:B" & lastRow)
        x = Rnd * (SW - w)
        y = Rnd * (SH - h)
        Set shp = sld.Shapes.AddTextbox(msoTextOrientationHorizontal, x, y, w, h)
        shp.Name = "Word_" & r.Row - 1 & "_" & r
        With shp.TextFrame2
            .WordWrap = msoFalse '줄바꿈 없음
            .TextRange = r.Text
            .TextRange.Font.Name = "Trebuchet MS"
            .TextRange.Font.Fill.ForeColor.RGB = rgbBlack
            If FontSZ = "" Then FontSZ = 10
            .TextRange.Font.Size = FontSZ   '글자크기
        End With
        Call reLocate(shp)
        shp.Select msoFalse
        
        If Hard Then
            x = Rnd * (SW - w)
            y = Rnd * (SH - h)
            'Set sld = ActivePresentation.Slides(1)
            Set shp = sld.Shapes.AddTextbox(msoTextOrientationHorizontal, x, y, w, h)
            
            With shp.TextFrame2
                .WordWrap = msoFalse '줄바꿈 없음
                rr = Rnd * (Len(r.Text) - 1)
                .TextRange = r.Text
                .TextRange.Characters(rr + 1).Text = Chr(Asc("a") + Rnd * 24)
                .Parent.Name = "Word_" & r.Row - 1 & "_" & .TextRange
                .TextRange.Font.Name = "Trebuchet MS"
                .TextRange.Font.Fill.ForeColor.RGB = rgbBlack
                .TextRange.Font.Size = FontSZ   '글자크기
            End With
            Call reLocate(shp)
            shp.Select msoFalse
        End If
    Next r
    With ActiveWindow.Selection.ShapeRange.Group
        .Name = "Word_Group_" & sld.Shapes.Count
        .ZOrder (msoBringToFront)
    End With
    
Oops:
    If Not xlsBook Is Nothing Then xlsBook.Close
    If Not xlsApp Is Nothing Then xlsApp.Quit: Set xlsApp = Nothing
    
End Sub

Function reLocate(oShp As Shape)
    'Randomize
    Dim sx As Single, sy As Single
    
    sx = oShp.Left: sy = oShp.Top
    While isDupLocation(oShp, sx, sy)
        sx = Rnd * (SW - w)
        sy = Rnd * (SH - h)
    Wend
    oShp.Left = sx
    oShp.Top = sy

End Function

Function isDupLocation(pShp, xx As Single, yy As Single) As Boolean
    Dim oSld As Slide
    Set oSld = pShp.Parent
    Dim shp As Shape
    Dim Found As Long

    For Each shp In oSld.Shapes
        With shp
            If .Name Like "Word_*" And .Name <> pShp.Name Then
                If xx <= .Left + w And .Left <= xx + w And .Top <= yy + h And yy <= .Top + h Then
                    Found = Found + 1
                End If
            End If
        End With
    Next shp
    If Found Then isDupLocation = True Else isDupLocation = False
End Function

Function existShp(oSld, sname As String) As Boolean
    Dim shp As Shape
    For Each shp In oSld.Shapes
        If shp.Name Like sname Then existShp = True: Exit For
    Next shp
End Function

Sub delWords(control As IRibbonControl)
    Dim i As Long
    Dim sld As Slide
    Set sld = ActiveWindow.View.Slide
        
    For i = sld.Shapes.Count To 1 Step -1
         If sld.Shapes(i).Name Like "Word_*" Then
            sld.Shapes(i).Delete
        End If
    Next i
    
End Sub

Sub HardEasy(control As IRibbonControl, pressed As Boolean)
    If pressed Then Hard = True Else Hard = False
    'MsgBox Hard
End Sub

Sub LayoutChange(control As IRibbonControl, lout As String)
    If Not IsNumeric(lout) Then MsgBox "레이아웃 번호 확인: " & lout: Exit Sub
    Dim sld As Slide
    On Error GoTo Oops:
    Set sld = ActiveWindow.View.Slide
    sld.CustomLayout = ActivePresentation.Designs(1).SlideMaster.CustomLayouts(Int(lout))
Oops:
    If Err Then MsgBox Err.Description
End Sub

Sub Layout_getText(control As IRibbonControl, ByRef returnedVal)
    returnedVal = 9    '기본 레이아웃배경
End Sub

Sub Font_getText(control As IRibbonControl, ByRef returnedVal)
    returnedVal = 10    '기본 폰트사이즈
End Sub

Sub FontSize(control As IRibbonControl, sz As String)
    If IsNumeric(sz) Then FontSZ = sz
    'MsgBox sz
End Sub

Sub About(control As IRibbonControl)
    MsgBox "Word Scatter" & vbNewLine & _
    "by konahn@naver.com" & vbNewLine & _
    "--------------------------" & vbNewLine & vbNewLine & _
    "This add-in will load a word list in Excel file " & vbNewLine & _
    "and scatter each word on the current slide. " & vbNewLine, vbInformation + vbSystemModal
    
End Sub

Sub onLoad(ribbon As IRibbonUI)
    ribbon.ActivateTab "WordScatter"
    'control.ActivateTabMso ("WordScatter")
    'Application.SendKeys "%Y%" 'Alt + Y + Alt
End Sub

Sub DrawLines(control As IRibbonControl)
    DivideScreen 0  '선으로 나누기
End Sub

Sub DrawBoxes(control As IRibbonControl)
    DivideScreen msoShapeRectangle  '박스 그리기
End Sub

Sub DrawTriangles(control As IRibbonControl)
    DivideScreen msoShapeRightTriangle  '랜덤 직각삼각형 그리기
End Sub

Function DivideScreen(Optional boxFlag As Integer = 0)

    Dim user As String
    Dim RowCol() As String
    Dim Rows As Integer, Cols As Integer
    Dim shpName As String
      
    If boxFlag = msoShapeRectangle Then shpName = "사각형" _
    Else If boxFlag = msoShapeRightTriangle Then shpName = "직각삼각형" _
    Else shpName = "직선"
    user = InputBox("현재 슬라이드를 가로, 세로로 등분하는 배경 도형(" & shpName & ")을 추가합니다.(기존 도형은 삭제)" & vbNewLine & vbNewLine & _
        "가로와 세로 칸수를 콤마(,)로 구분해서 입력하세요:" & vbNewLine & "(예: 3, 2 =>가로3칸*세로2칸/ 6,4  / 32, 32 등)", "화면 등분", "8,4")
    If Len(user) = 0 Then Exit Function
    
    RowCol = Split(user, ",")
    
    If UBound(RowCol) <> 1 Then MsgBox "콤마로 구분된 숫자2개가 아닙니다.": Exit Function
    If Not IsNumeric(RowCol(0)) Or Not IsNumeric(RowCol(1)) Then _
        MsgBox "숫자로 입력하세요.": Exit Function
        
    Cols = CInt(RowCol(0)): Rows = CInt(RowCol(1))
    Call Divide(Cols, Rows, boxFlag)
    'Call Divide(3, 2) ' 3x2로 화면을 나누는 경우
End Function

Function Divide(Col As Integer, Row As Integer, oBox As Integer)
    Dim sld As Slide
    Dim shp As Shape
    'Dim SW As Single, SH As Single
    Dim BoxW As Single, BoxH As Single
    Dim i As Integer, j As Integer, k As Long
          
    Randomize
    
    Set sld = ActiveWindow.View.Slide
    
    '기존 선이 있으면 삭제
    If existShp(sld, "Group_*") Then _
        If MsgBox("기존 도형들을 지울까요?", vbOKCancel) = vbOK Then Call RemoveGroupShapes(sld)
    
    '화면 가로 세로 크기
    SW = ActivePresentation.PageSetup.SlideWidth
    SH = ActivePresentation.PageSetup.SlideHeight
    
    '박스 하나의 가로 세로 크기
    BoxW = SW / Col
    BoxH = SH / Row
    
    k = 0
    With sld.Shapes
        If oBox Then        '박스 추가

            For i = 1 To Col
                For j = 1 To Row    'ActivePresentation.Slides(1).Shapes
                    With .AddShape(oBox, BoxW * (i - 1), BoxH * (j - 1), BoxW, BoxH)
                        .Name = "Box_" & i & "_" & j
                        If oBox = msoShapeRightTriangle Then
                            If Int(Rnd * 2) Then
                                .Fill.ForeColor.RGB = rgbGray
                            Else
                                If Int(Rnd * 2) Then .Fill.ForeColor.RGB = RGB(200, 200, 200) _
                                    Else .Fill.ForeColor.RGB = rgbWhite
                            End If
                            .Fill.Transparency = 0.6
                            .Line.Weight = 0.2
                            .Line.ForeColor.RGB = rgbLightGray
                            .Line.Transparency = 0.6
                        ElseIf oBox = msoShapeRectangle Then
                            If (i + j) Mod 2 = 1 Then .Fill.ForeColor.RGB = rgbLightGray _
                                Else .Fill.Visible = msoFalse
                            .Fill.Transparency = 0.5
                            .Line.Weight = 0.5              '선 두께
                            .Line.ForeColor.RGB = rgbGray '선 색상 rgbGray, RGB(125,125,125) 등
                            .Line.DashStyle = msoLineDash   '점선이 아닐경우 주석처리
                            .Line.Transparency = 0.6
                            .Line.Visible = msoFalse
                        Else
                            .Fill.Visible = msoFalse
                            .Line.Weight = 0.5              '선 두께
                            .Line.ForeColor.RGB = rgbLightGray '선 색상 rgbGray, RGB(125,125,125) 등
                            .Line.DashStyle = msoLineDash   '점선이 아닐경우 주석처리
                            .Line.Transparency = 0.6
                        End If
                        If oBox = msoShapeRightTriangle Then
                            If .Fill.ForeColor.RGB = rgbGray Then .Select False
                        Else
                            .Select False                   '그룹으로 합치기 위해 미리 선택
                        End If

                    End With
                    k = k + 1

                Next j
            Next i
            
        Else                 '직선 추가
        
            '세로줄 긋기
            For i = 1 To Col - 1
                With .AddLine(BoxW * i, 0, BoxW * i, SH)
                    .Name = "Line_V" & i
                    .Line.Weight = 0.5              '선 두께
                    .Line.ForeColor.RGB = rgbLightGray '선 색상 rgbGray, RGB(125,125,125) 등
                    .Line.DashStyle = msoLineDash   '점선이 아닐경우 주석처리
                    .Line.Transparency = 0.4
                    .Select False                   '그룹으로 합치기 위해 미리 선택
                End With
                
            Next i
            
            '가로줄 긋기
            For i = 1 To Row - 1
                With .AddLine(0, BoxH * i, SW, BoxH * i)
                    .Name = "Line_H" & i
                    .Line.Weight = 0.5
                    .Line.ForeColor.RGB = rgbLightGray
                    .Line.DashStyle = msoLineDash
                    .Line.Transparency = 0.4
                    .Select False
                End With
               
            Next i
        End If

    End With
    
    '선택된 가로, 세로선들을 그룹으로 묶기
    With ActiveWindow.Selection.ShapeRange.Group
        .Name = "Group_Box_" & sld.Shapes.Count
        .ZOrder (msoSendToBack)
    End With
    If oBox = msoShapeRightTriangle Then
        For Each shp In sld.Shapes
            If shp.Name Like "Box_*" Then shp.Select msoFalse
        Next shp
        With ActiveWindow.Selection.ShapeRange.Group
            .Name = "Group_Box" & sld.Shapes.Count
            .ZOrder (msoSendToBack)
        End With
    End If
    
    
End Function

Sub delGroups(control As IRibbonControl)
    Dim sld As Slide
    Set sld = ActiveWindow.View.Slide
    
    Call RemoveGroupShapes(sld)
End Sub

'Group_'로 시작하는 이름을 가진 도형 모두 삭제
Function RemoveGroupShapes(oSld As Slide)
    Dim i As Integer
    
    With oSld
        For i = .Shapes.Count To 1 Step -1
            If .Shapes(i).Name Like "Group_*" Then .Shapes(i).Delete
        Next i
    End With
End Function

Sub DrawArcs(control As IRibbonControl)
    Dim sld As Slide
    Dim i%
    Const START = 30
    Const STEP = 20
    Dim shp As Shape
    Dim w!, h!
    Dim user As String
    Dim Max As Integer
        
    user = InputBox("치우친 원의 개수를 입력하세요:", "치우친 원 그리기", "15")
    If Len(user) = 0 Then Exit Sub
    Max = CInt(user)
    
    Set sld = ActiveWindow.View.Slide
    '기존 선이 있으면 삭제
    If existShp(sld, "Group_*") Then _
        If MsgBox("기존 도형들을 지울까요?", vbOKCancel) = vbOK Then Call RemoveGroupShapes(sld)

    SW = ActivePresentation.PageSetup.SlideWidth
    SH = ActivePresentation.PageSetup.SlideHeight
    
    With sld.Shapes 'ActivePresentation.Slides(1).Shapes
        For i = 1 To Max
            w = (START * 2) + (i * STEP): h = w
            Set shp = .AddShape(msoShapeArc, SW / 2 - w / 2, SH / 2 - h / 2, w, h)
            With shp
                .Name = "Arc_" & i
                .Line.ForeColor.RGB = rgbLightGray
                .Adjustments(1) = 0.8
                .Adjustments(2) = 0.2
                shp.Select False
            End With
        Next i
    End With
    With ActiveWindow.Selection.ShapeRange.Group
        .Name = "Group_Arc_" & sld.Shapes.Count
        .ZOrder (msoSendToBack)
    End With
End Sub

Sub DrawOrbits(control As IRibbonControl)
    Dim sld As Slide
    Dim i%
    Const START = 30
    Const STEP = 10
    Dim shp As Shape
    Dim w!, h!, clr%
    Dim user As String
    Dim Max As Integer
    
    user = InputBox("무작위 원호(Arc)의 개수를 입력하세요:", "무작위 원호 그리기", "20")
    If Len(user) = 0 Then Exit Sub
    Max = CInt(user)
    Set sld = ActiveWindow.View.Slide
    
    '기존 선이 있으면 삭제
    If existShp(sld, "Group_*") Then _
        If MsgBox("기존 도형들을 지울까요?", vbOKCancel) = vbOK Then Call RemoveGroupShapes(sld)

    SW = ActivePresentation.PageSetup.SlideWidth
    SH = ActivePresentation.PageSetup.SlideHeight
    
    Randomize

    With sld.Shapes     'ActivePresentation.Slides(1).Shapes
        For i = 0 To Max
            w = START + (i * STEP): h = w
            Set shp = .AddShape(msoShapeArc, SW / 2, SH / 2 - h, w, h)
            With shp
                .Name = "Orbit_" & i
                clr = 220 + Int(Rnd * 35)
                .Line.ForeColor.RGB = RGB(clr, clr, clr)
                .Line.Weight = Rnd * 2
                .Adjustments(1) = Int(Rnd * 270) + 90
                .Adjustments(2) = .Adjustments(1) + Int(Rnd * 270) + 90
                .Select False
            End With
        Next i
        Set shp = Nothing
    End With
    With ActiveWindow.Selection.ShapeRange.Group
        .Name = "Group_Orbit_" & sld.Shapes.Count
        .ZOrder (msoSendToBack)
    End With
End Sub

'부채꼴 삽입
Sub DrawBlockArcs(control As IRibbonControl)
    Dim sld As Slide
    Dim i As Integer
    Dim Max As Integer
    Dim user As String
    Dim Adj3 As Double
      
    user = InputBox("부채꼴(BlockArc)의 개수를 입력하세요:", "부채꼴그리기", "12")
    If Len(user) = 0 Then Exit Sub
    Max = CInt(user)
    
    user = InputBox("부채꼴(BlockArc)의 반지름을 입력하세요: 0~0.5", "부채꼴그리기", "0.25")
    If Len(user) = 0 Then Exit Sub
    Adj3 = CDbl(user)
    
    Set sld = ActiveWindow.View.Slide
    
    '기존 선이 있으면 삭제
    If existShp(sld, "Group_*") Then _
        If MsgBox("기존 도형들을 지울까요?", vbOKCancel) = vbOK Then Call RemoveGroupShapes(sld)

    Randomize
    
    SW = ActivePresentation.PageSetup.SlideWidth
    SH = ActivePresentation.PageSetup.SlideHeight
    
    For i = 1 To Max
        With sld.Shapes.AddShape(msoShapeBlockArc, SW / 2 - SH / 2, 0, SH, SH)
            .Name = "Circle" & i
            .Adjustments(1) = (i - 1) * (360 / Max) + 270
            .Adjustments(2) = .Adjustments(1) + (360 / Max)
            .Adjustments(3) = Adj3
            '.Fill.ForeColor.RGB = RGB(256 - 256 / Max * i, 256 - 256 / Max * i, 256 - 256 / Max * i)
            .Fill.ForeColor.RGB = RGB(128 + 128 * Rnd, 128 + 128 * Rnd, 128 + 128 * Rnd)
            .Line.Visible = msoFalse
            .Select False
'            With .TextFrame.TextRange
'                .Text = i
'                .Font.Size = 20
'                .Font.Bold = msoTrue
'            End With
        End With
    Next i
    With ActiveWindow.Selection.ShapeRange.Group
        .Fill.Transparency = 0.5
        .Name = "Group_BlockArc_" & sld.Shapes.Count
        .ZOrder (msoSendToBack)
    End With
End Sub

 

다음 첨부파일 안의 두 가지 파일(WordList25.xlsm, WordScatter.pptm)을 참고하세요.

WordScatter.zip
4.69MB

압축 암호는 konahn 입니다.

 

1. 인쇄할 때 흑백 레이저 프린터의 경우 '칼라'로 인쇄하는 것이 배경이 흐릿하게 출력이 됩니다.

흑백이나 회색조로 인쇄하면 배경이 너무 진하게 출력됩니다.

 

2. 몇몇 백신이나 티스토리서버에서 WordList25.xlsm 파일의 바이러스감염을 의심하지만

URLDownloadFile API를 사용할 뿐 바이러스와 전혀 관련이 없습니다.

VBA 소스도 모두 공개되어 있습니다.