랜덤 주사위 + 누적 통계 차트

 

Click the Dice를 누릅니다.

그러면 랜덤으로 3D 주사위가 뜨면서 주사위 눈이 나타납니다.

또한 횟수와 각 눈별  누적 개수를 차트로 보여줍니다.

 

아래와 같은 스타일의 차트도 가능합니다.

 

아래와 같은 스타일의 차트도 가능합니다.

 

ReStart 를 누르면 차트 누적 데이터를 초기화하고 첫 슬라이드로 다시 시작합니다.

 

실행화면:

 

 

사용 코드:

Option Explicit

Dim dRound As Integer    '회차
Const Stage = 2             '무대는 3슬라이드

Sub ReStart()
    Reset
    SlideShowWindows(1).View.GotoSlide 1, msoTrue
End Sub

Sub Roll()
    Dim i As Integer
    Dim r As Integer
    Dim shp As Shape
    
    Randomize
    r = Int(Rnd * 6) + 1
    
    With ActivePresentation.Slides(Stage)
        '주사위 회전 각도
        Set shp = .Shapes("DICE3D")
        With shp.Model3D
            .ResetModel
            Select Case r
                Case 1:
                    .RotationX = 180
                Case 2:
                    .RotationX = 90
                Case 3:
                    .RotationY = 90
                Case 4:
                    .RotationY = 270
                Case 5:
                    .RotationX = 270
                Case 6:
            End Select
        End With
        
        '횟수 표시
        dRound = dRound + 1
        .Shapes("Chart 1").Chart.ChartTitle.Text = dRound & "회차"
        With .Shapes("Chart 1").Chart.ChartData
            .ActivateChartDataWindow
            With .Workbook.Worksheets(1)
                .Cells(1, 2) = "횟수"
                .Cells(r + 1, 2) = .Cells(r + 1, 2) + 1
            End With
            .Workbook.Close
        End With
        '.Shapes("Chart 1").Chart.Refresh
        SlideShowWindows(1).View.GotoSlide Stage, msoTrue

    End With
    
End Sub

Function Reset()
    Dim i As Integer
    With ActivePresentation.Slides(Stage)
    
        '횟수 표시
        dRound = 0
        .Shapes("Chart 1").Chart.ChartTitle.Text = dRound & "회차"
        
        '기존 다이스, 누적 결과 지우기
         With .Shapes("Chart 1").Chart.ChartData
            .ActivateChartDataWindow
            With .Workbook.Worksheets(1)
                .Cells(1, 2) = "횟수"
                For i = 1 To 6
                    .Cells(i + 1, 2) = 0
                Next i
            End With
            .Workbook.Close
         End With
         '.Shapes("Chart 1").Chart.Refresh
    End With
    
     'SlideShowWindows(1).View.GotoSlide Stage, msoTrue
End Function

Sub onSlideShowTerminate(ssw As SlideShowWindow)
    Dim title As String
    title = ActivePresentation.Slides(Stage).Shapes("Chart 1").Chart.ChartTitle.Text
    If title <> "0회차" Then
        If MsgBox(Stage & "슬라이드의 주사위 횟수기록을 초기화할까요?", vbYesNo) = vbYes Then Reset
    End If
End Sub

 

 

파일 다운로드:

 

기본 세로 막대 스타일 차트

Dice3Du.pptm

1.43MB

 

가로 막대 스타일 차트

Dice3Dr.pptm

1.40MB

 

세로 주사위 막대 스타일 차트

Dice3Dd.pptm

1.72MB

 

3D Dice 출처:

https://sketchfab.com/3d-models/dice-d796ac8f56db4dc78ed18be534939225

Dice - Download Free 3D model by TheBoss009SS - Sketchfab