[VBA] 엑사남들이 빼빼로데이를 즐기는 법

 

 

https://open.kakao.com/o/glXWEB3b

유튜브 '엑사남'의 Excel VBA 함께하기

그러하다..우리가 빼빼로데이를 즐기는 법

사랑스럽지 아니한가

 

코드는 생각보다 단순하다.

직사각형을 만들고 가장 하단의 직사각형에 작은 원들을 넣고 주변색과 같은 직사각형을 양쪽에 삽입하여 마치 원이 짤린 반원 모양으로 되게 하는 것이다.

그리고 마지막으로 배경색과 같은 큰 직사각형으로 완성된 빼빼로를 덮은 후 천천히 좌표를 이동시켜 마치 빼빼로가 위에서부터 내려오는 것 처럼 만든것이다.

 

도형을 이동하는 코드는 엑사남 3강에 다뤘던 내용이다..

진짜 버릴께 하나도 없다...엑사남 강의는......

https://www.youtube.com/watch?v=1ueDvcQBXzE 

Option Explicit
Sub 빼빼로데이()
    
    Dim shp As Shape
    Dim i&
    
    For Each shp In ActiveSheet.Shapes                '= 버튼외에 모든 도형을 삭제해라
        If shp.Name <> "Button 1" Then shp.Delete
    Next shp
    
    Application.ScreenUpdating = False
        Set shp = ActiveSheet.Shapes.AddShape(1, 50, 7, 8, 110)  '= 빼빼로 상단 구성
            Call F_color(shp)
            
        Set shp = ActiveSheet.Shapes.AddShape(1, 50, 120, 8, 110) '= 빼빼로 중간 구성
            Call F_color(shp)
            
        Set shp = ActiveSheet.Shapes.AddShape(1, 50, 233, 8, 80)  '= 빼빼로 하단 구성
            Call B_color(shp)
            
        Set shp = ActiveSheet.Shapes.AddShape(9, 46, 265, 8, 8)   '= 빼빼로 하단 반원 구성
            Call R_color(shp)
        
        Set shp = ActiveSheet.Shapes.AddShape(9, 46, 295, 8, 8)
            Call R_color(shp)
            
        Set shp = ActiveSheet.Shapes.AddShape(9, 54, 250, 8, 8)
            Call R_color(shp)
            
        Set shp = ActiveSheet.Shapes.AddShape(9, 54, 280, 8, 8)
            Call R_color(shp)
            
        Set shp = ActiveSheet.Shapes.AddShape(1, 39.5, 1, 10, 350) '= 원을 반원으로 보이도록 하얀색 직사각형으로 crop
            Call C_color(shp)
            
        Set shp = ActiveSheet.Shapes.AddShape(1, 58.5, 1, 10, 350) '= 원을 반원으로 보이도록 하얀색 직사각형으로 crop
            Call C_color(shp)
            
    Application.ScreenUpdating = True
        Set shp = ActiveSheet.Shapes.AddShape(1, 1, 1, 107, 350)   '= 완성된 빼빼로를 하얀색 직사각형으로 숨김
            Call C_color(shp)
            
            For i = 1 To 21                                        '= 하얀색 직사각형을 밑으로 내리면서 빼빼로 공개
                shp.Top = Range("a" & i).Top
                Application.Wait (Now + TimeValue("0:00:01"))      '= 1초씩 지연
            Next i
            
        MsgBox "행복한 빼빼로데이 되세요." & vbCrLf & "                 - from Haja"
            
End Sub

Sub F_color(shp As Shape)

    shp.Fill.ForeColor.RGB = RGB(153, 102, 51)
    shp.Line.ForeColor.RGB = RGB(0, 0, 0)

End Sub

Sub B_color(shp As Shape)

    shp.Fill.ForeColor.RGB = RGB(255, 219, 77)
    shp.Line.ForeColor.RGB = RGB(0, 0, 0)

End Sub

Sub R_color(shp As Shape)

    shp.Fill.ForeColor.RGB = RGB(179, 143, 0)
    shp.Line.ForeColor.RGB = RGB(0, 0, 0)

End Sub

Sub C_color(shp As Shape)

    shp.Fill.ForeColor.RGB = RGB(255, 255, 255)
    shp.Line.ForeColor.RGB = RGB(255, 255, 255)

End Sub

빼빼로.xlsm

0.02MB