VBA로 슬라이드 자동 생성 - '자주 쓰는 영어속담 50개'

https://www.fluentu.com/blog/english-kor/지금-바로-배워야-할-가장-유용한-영어-속담-50-가지

지금 바로 배워야 할 가장 유용한 영어 속담 50 가지

위 사이트의 내용(이미지와 텍스트)을 가져와서 자동으로

슬라이드 50개를 생성하는 매크로입니다.

 

첫 화면

 

1번 슬라이드 - 속담 설명은 속담을 클릭해야만 나옵니다.

HTML구조는 아래와 같습니다.

 ~~~ 생 략 ~~~
<h2>영어를 쓰는 모든 사람들이 알아야 할 유용한 속담 50 가지</h2>

<h3>1. The grass is always greener on the other side of the fence.</h3>
<p><a href="https://www.fluentu.com/blog/english-kor/wp-content/uploads/sites/32/2015/02/50-useful-proverbs-all-english-speakers-should-know1.jpg">
<img class="alignnone wp-image-3181" src="https://www.fluentu.com/blog/english-kor/wp-content/uploads/sites/32/2015/02/50-useful-proverbs-all-english-speakers-should-know1-300x222.jpg" alt="50 useful proverbs all english speakers should know" width="400" height="296" srcset="https://www.fluentu.com/blog/english-kor/wp-content/uploads/sites/32/2015/02/50-useful-proverbs-all-english-speakers-should-know1-300x222.jpg 300w, https://www.fluentu.com/blog/english-kor/wp-content/uploads/sites/32/2015/02/50-useful-proverbs-all-english-speakers-should-know1.jpg 1000w" sizes="(max-width: 400px) 100vw, 400px"></a></p>

<p>“The grass is always greener” 은 우리에게 jealous (다른 사람들이 가진 것을 원하는 것) 하는 것은 좋지 않다는 것을 가르쳐 줍니다. 당신 주변의 모든 사람들이 더 좋은 차, 좋은 직장 등과 같은 “greener grass” 를 가진 것처럼 보입니다.</p><p>그러나 당신의 이웃들은 아마 당신이 더 푸른 잔디를 가졌다고 생각할지도 모릅니다. 당신의 친구들과 다른 사람들은 당신이 더 나은 외모, <a href="https://www.fluentu.com/english/blog/advanced-english-vocabulary-happy/" target="_blank" title="Advanced English Vocabulary: 16 Kinds of Happy" rel="noopener">행복한</a> 가족 등을 가졌다고 생각할지도 모르는 것이지요. 그러니, 다른 사람들이 가진 것에 대해 생각하는 대신 자신이 가지고 있는 것에 감사하라고 이 속담은 말하고 있습니다.</p>


<h3>2. Don’t judge a book by its cover.</h3><p><a href="https://www.fluentu.com/blog/english-kor/wp-content/uploads/sites/32/2015/02/50-useful-proverbs-all-english-speakers-should-know2.jpg"><img class="alignnone wp-image-3183" src="https://www.fluentu.com/blog/english-kor/wp-content/uploads/sites/32/2015/02/50-useful-proverbs-all-english-speakers-should-know2-300x192.jpg" alt="50 useful proverbs all english speakers should know" width="400" height="256" srcset="https://www.fluentu.com/blog/english-kor/wp-content/uploads/sites/32/2015/02/50-useful-proverbs-all-english-speakers-should-know2-300x192.jpg 300w, https://www.fluentu.com/blog/english-kor/wp-content/uploads/sites/32/2015/02/50-useful-proverbs-all-english-speakers-should-know2-700x450.jpg 700w, https://www.fluentu.com/blog/english-kor/wp-content/uploads/sites/32/2015/02/50-useful-proverbs-all-english-speakers-should-know2.jpg 1000w" sizes="(max-width: 400px) 100vw, 400px"></a></p>
~~~ 생 략 ~~~

 

Early Binding이라 Alt-F11 도구-참조에서 

Microsoft HTML Object , XML6.0 Library 두 가지 라이브러리를 체크해줘야 합니다.

 

영어속담 문구는 <h3>태그를 찾아서 가져오고

이미지는 <a > 태그중에서 .jpg 확장자인 링크를 가져옵니다.

속담 설명(코멘트)의 경우는 따로 태그가 없어서

HTML문자열을 </H3> 으로 Split해서 나온 문자열에서

두번째 <p>태그를 통해 찾아 옵니다.

 

'add reference to Microsoft HTML Object , XML6.0 Library
Option Explicit

Sub getThemAll()

    Dim http As MSXML2.XMLHTTP
    Dim html As MSHTML.HTMLDocument
    Dim eleCol As MSHTML.IHTMLElementCollection
    Dim ele As MSHTML.IHTMLElement
    Dim URL As String
    Dim proverb As Collection, img As Collection
    Dim temp() As String, tmp As String, comment As Collection
    Dim i As Integer
    
    Set http = New MSXML2.XMLHTTP
    Set html = New MSHTML.HTMLDocument
    Set proverb = New Collection
    Set img = New Collection
    Set comment = New Collection
    
    'URL = "https://www.fluentu.com/blog/english-kor/지금-바로-배워야-할-가장-유용한-영어-속담-50-가지"
    URL = "https://www.fluentu.com/blog/english-kor/%EC%A7%80%EA%B8%88-%EB%B0%94%EB%A1%9C-%EB%B0%B0%EC%9B%8C%EC%95%BC-%ED%95%A0-%EA%B0%80%EC%9E%A5-%EC%9C%A0%EC%9A%A9%ED%95%9C-%EC%98%81%EC%96%B4-%EC%86%8D%EB%8B%B4-50-%EA%B0%80%EC%A7%80/"
    With http
        .Open "Get", URL, False
        .setRequestHeader "User-Agent", "Mozilla/5.0"
            'Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome
        .send
        Do
            DoEvents    '.waitForResponse
        Loop While .readyState <> 4
        html.body.innerHTML = .responseText
        
    End With

    '속담 가져오기
    Set eleCol = html.getElementsByTagName("h3")
    For Each ele In eleCol
        If ele.innerText Like "*#. *" Then proverb.Add ele.innerText
    Next ele
    
    '이미지 가져오기
    'https://www.fluentu.com/blog/english-kor/wp-content/uploads/sites/32/2015/02/50-useful-proverbs-all-english-speakers-should-know1.jpg
    Set eleCol = html.getElementsByTagName("a")
    For Each ele In eleCol
        If ele.href Like "*.jpg" Then img.Add ele.href
    Next ele
    
    '코멘트 가져오기
    temp = Split(html.body.innerHTML, "</H3>")
    For i = 3 To UBound(temp)
        html.body.innerHTML = temp(i)
        On Error Resume Next
        tmp = html.getElementsByTagName("p")(1).innerText
        On Error GoTo 0
        If Len(tmp) > 1 Then comment.Add tmp
    Next i
    
    Dim pres As Presentation
    Dim sld As Slide
    Dim shpi As Shape, shp As Shape, shp1 As Shape
    Dim sW!, sH!
    Dim eft As Effect
    
    Set pres = ActivePresentation
    sW = pres.PageSetup.SlideWidth
    sH = pres.PageSetup.SlideHeight
    For i = 1 To proverb.Count
    
        '슬라이드 추가
        Set sld = pres.Slides.Add(pres.Slides.Count + 1, ppLayoutBlank)
        sld.Tags.Add "no", sld.SlideIndex
        
        '이미지 추가
        Set shpi = sld.Shapes.AddPicture(img.Item(i + 1), msoFalse, msoTrue, 0, 0, sW, sH)
        shpi.Name = "img" & i

        '속담 추가
        Set shp = sld.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, sW, 50)
        shp.Name = "text" & i
        shp.Fill.ForeColor.RGB = RGB(60, 60, 80)
        shp.Fill.Transparency = 0.5
        With shp.TextFrame.TextRange
            .Text = proverb.Item(i) '속담
            .Font.Name = "Britannic Bold"
            .Font.Color.RGB = rgbYellow
            .Font.Size = 30
            .Font.Shadow = msoTrue
            shp.Height = .Lines.Count * 50  '줄 수에 따라 늘림
        End With
        shp.TextFrame2.TextRange.Font.Spacing = -1
        
        '// 애니메이션 효과
        Set eft = sld.TimeLine.MainSequence.AddEffect( _
            shp, msoAnimEffectFade, , msoAnimTriggerOnPageClick)
        eft.Timing.Duration = 1
        '// 트리거애니메이션 효과
        'Set eft = sld.TimeLine.InteractiveSequences.Add(1).AddTriggerEffect( _
        '    shp, msoAnimEffectFade, msoAnimTriggerOnShapeClick, shpi)
        'eft.Timing.Duration = 1
        
        '코멘트 추가
        Set shp1 = sld.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, shp.Top + shp.Height, sW, 20)
        shp1.Name = "comment" & i
        shp1.Fill.ForeColor.RGB = RGB(20, 20, 30)
        shp1.Fill.Transparency = 0.5
        With shp1.TextFrame.TextRange
            .Text = comment.Item(i) '속담
            '.Font.Name = "Britannic Bold"
            .Font.Color.RGB = rgbWhite
            .Font.Size = 15
            '.Font.Shadow = msoTrue
            shp1.Height = .Lines.Count * 20  '줄 수에 따라 늘림
        End With
        shp1.TextFrame2.TextRange.Font.Spacing = -1
        shp.ZOrder msoBringToFront '속담을 맨 앞으로
        
        '// 트리거애니메이션 효과
        Set eft = sld.TimeLine.InteractiveSequences.Add(1).AddTriggerEffect( _
            shp1, msoAnimEffectFly, msoAnimTriggerOnShapeClick, shp)
        eft.Timing.Duration = 1
        eft.EffectParameters.Direction = msoAnimDirectionUp
        
        '// 화면 전환
        sld.SlideShowTransition.EntryEffect = ppEffectRandom
        sld.SlideShowTransition.Speed = ppTransitionSpeedFast
    Next i
    
Oops:
    Set http = Nothing
    Set html = Nothing
End Sub

 

영어속담 부분에는 일반 애니메이션 효과를 주고

속담설명은 영어속담을 클릭해야 나타나는 트리거 애니메이션 효과를 주었습니다.

또한 각 슬라이드마다 랜덤 화면전환 효과를 주었습니다. 

 

추가로

슬라이드를 섞고 슬라이드에 미리 저장된 Tag를 이용해 다시 순서를 되돌리는 매크로입니다.

Sub ShuffleSlides()

    Dim pres As Presentation
    Dim t As Long, i As Long
    
    If MsgBox("슬라이드 순서를 섞습니다.", vbOKCancel) = vbCancel Then Exit Sub
    
    Randomize
    Set pres = ActivePresentation
    t = pres.Slides.Count
    If t < 3 Then Exit Sub
    For i = 2 To t
        pres.Slides(i).MoveTo Int((t - 1) * Rnd) + 2
    Next i
    
End Sub

Sub ReorderSlides()

    Dim pres As Presentation
    Dim i As Long, j As Long, f As Long, t As Long
    
    If MsgBox("슬라이드 순서를 원래대로 되돌립니다.", vbOKCancel) = vbCancel Then Exit Sub
    
    Set pres = ActivePresentation
    t = pres.Slides.Count

    For i = t To 2 Step -1
        For j = i To 2 Step -1
            If pres.Slides(j).Tags("no") = i Then Exit For
        Next j
        pres.Slides(j).MoveTo i
    Next i
    
End Sub

 

자주쓰는영어속담1.pptm

0.14MB

첨부파일에는 1슬라이드 외에 슬라이드 내용이 아직 들어 있지 않습니다.

글꼴 또한 포함하지 않았습니다.

매크로 허용해서 연 다음 Alt-F8로 getThemAll 매크로를 실행하면 50 슬라이드를 생성합니다.

온라인 접속해서 파싱하고 슬라이드를 생성하는데 1분여의 시간이 걸립니다.

 

본 매크로는 인터넷 문서 파싱에 대한 예제 혹은 학습자료입니다.

*  원 사이트의 HTML 구조가 달라지면 작동하지 않습니다.

** 주의: 원 사이트 자료의 저작권은 해당 저작권자에게 있습니다.