휠 다이아그램(사이퍼디스크) 자동으로 만들기

아래처럼 휠 다이아그램 혹은 사이퍼 디스크 모양을 ppt에서 만들어 보겠습니다.

원 출처는 아래 지식인 질문입니다. 

https://kin.naver.com/qna/detail.nhn?d1id=1&dirId=102&docId=303978262

다른 분께서 도너츠모양 챠트를 이용한 방법을 답변해주셨습니다.

https://blog.naver.com/lemon-butter/221303482267

저는 VBA를 이용해서 만드는 방법을 소개합니다.

원래 Jobs라는 추가기능으로 만들어뒀던 매크로를 약간 수정했습니다.

먼저 첨부파일을 다운로드하여 열어주세요.

휠다이아그램.pptm

매크로 컨텐츠는 반드시 허용해야 합니다.

1. 빈슬라이드를 만들고

Alt-F8이나 개발도구-매크로를 눌러서

AddBlockArc1() 을 실행합니다.

알파벳도 자동으로 들어가게 됩니다.

2. 원본과 유사하게 그림자를 아래처럼 설정합니다.

미리설정에서 가운데 그림자로 한 다음

특히 그림자 크기를 75%정도로 줄여야 안쪽으로 그림자가 생깁니다.

3. 도형의 채우기색을 아래처럼

그라데이션 방사형으로 설정합니다.

4. 다음 AddBlockArc2() 매크로를 실행해줍니다.

자동으로 안쪽에 배경이 투명한 작은 동그라미를 만들어줍니다.

숫자도 자동으로 들어갑니다.

5. 이제 두개의 그룹을 하나의 그룹으로 합칩니다.

그리고 우클릭하여 그림으로 저장합니다.

EMF확장자를 추천합니다.

파워포인트에서 가져오면그림처럼 삽입되지만 

우클릭 - 그림편집 클릭해서 MS오피소 도형으로 바꾸면 

파워포인트에서 바로 수정할 수 있는 장점이 있습니다.

(물론 이경우에는 약간 깨집니다)

최종결과물

매크로 소스는 아래와 같습니다.  소스보기를 누르세요.

 
'아래 매크로는 Jobs 추가기능중의 하나를 변형하였습니다.
'http://cafe.naver.com/gameppt/139722
 
 
Option Explicit
 
'부채꼴 삽입
Sub AddBlockArc1()
    Dim i As Integer
    Dim w As Single, h As Single
    Dim Max As Integer
    Dim user As String
    Dim Adj3 As Double
    Dim SLD As Slide
    
    On Error GoTo ErrMsg:
    Set SLD = ActiveWindow.View.Slide
    
    user = InputBox("부채꼴(BlockArc)1의 개수를 입력하세요:", "부채꼴그리기", "26")
    If Len(user) = 0 Then Exit Sub
    Max = CInt(user)
    
    user = InputBox("부채꼴(BlockArc)1의 반지름을 입력하세요: 0~0.5", "부채꼴그리기", "0.1")
    If Len(user) = 0 Then Exit Sub
    Adj3 = CDbl(user)
    
    w = ActivePresentation.PageSetup.SlideWidth
    h = ActivePresentation.PageSetup.SlideHeight
    Randomize
    For i = 1 To Max
        With SLD.Shapes.AddShape(msoShapeBlockArc, w / 2 - h / 2, 0, h, h)
            .Name = "BlockArc_" & i
            .Adjustments(1) = 270                           '(i - 1) * (360 / Max) + 270
            .Adjustments(2) = .Adjustments(1) + 360 / Max   '.Adjustments(1) + (360 / Max)
            .Adjustments(3) = Adj3
            .Rotation = 360 / Max * (i - 1)
            '.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)
            .Fill.ForeColor.RGB = rgbGray
            .Line.Visible = msoTrue
            .Line.ForeColor.RGB = rgbDarkGray
            .Line.Weight = 0.25
            .Select False
            With .TextFrame.TextRange
                .Text = Chr(Asc("A") + i - 1)   '문자
                .Font.Color = rgbWhite
                .Font.Size = 25
                .Font.Bold = msoTrue
            End With
        End With
    Next i
    
    ActiveWindow.Selection.ShapeRange.Group.Name = "Arc_Group_" & SLD.Shapes.Count
    Exit Sub
    
ErrMsg:
    MsgBox "슬라이드를 선택하세요." & vbNewLine & vbNewLine & _
        Err.Description, vbCritical
        
End Sub
 
 
 
'부채꼴 삽입
Sub AddBlockArc2()
    Dim i As Integer
    Dim w As Single, h As Single
    Dim Max As Integer
    Dim user As String
    Dim Adj3 As Double
    Dim SLD As Slide
    
    On Error GoTo ErrMsg:
    Set SLD = ActiveWindow.View.Slide
    
    user = InputBox("부채꼴(BlockArc)2의 개수를 입력하세요:", "부채꼴그리기", "26")
    If Len(user) = 0 Then Exit Sub
    Max = CInt(user)
    
    user = InputBox("부채꼴(BlockArc)2의 반지름을 입력하세요: 0~0.5", "부채꼴그리기", "0.1")
    If Len(user) = 0 Then Exit Sub
    Adj3 = CDbl(user)
    
    w = ActivePresentation.PageSetup.SlideWidth - 100
    h = ActivePresentation.PageSetup.SlideHeight - 100
    Randomize
    For i = 1 To Max
        With SLD.Shapes.AddShape(msoShapeBlockArc, 50 + w / 2 - h / 2, 50, h, h)
            .Name = "BlockArc_" & i
            .Adjustments(1) = 270                           '(i - 1) * (360 / Max) + 270
            .Adjustments(2) = .Adjustments(1) + 360 / Max   '.Adjustments(1) + (360 / Max)
            .Adjustments(3) = Adj3
            .Rotation = 360 / Max * (i - 1)
            '.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)
            .Fill.ForeColor.RGB = rgbWhite
            .Fill.Transparency = 1
            '.Fill.BackColor.RGB = rgbWhite
            .Line.ForeColor.RGB = rgbWhite
            .Line.Transparency = 1
            '.Line.BackColor.RGB = rgbWhite
            .Line.Weight = 1
            .Line.Visible = msoFalse
            .Select False
            With .TextFrame.TextRange
                .Text = i       '숫자
                .Font.Color = rgbDarkGray
                .Font.Size = 18
                .Font.Bold = msoTrue
            End With
        End With
    Next i
    
    ActiveWindow.Selection.ShapeRange.Group.Name = "Arc_Group_" & SLD.Shapes.Count
    Exit Sub
    
ErrMsg:
    MsgBox "슬라이드를 선택하세요." & vbNewLine & vbNewLine & _
        Err.Description, vbCritical
        
End Sub