'/// 모듈 1 *******************************************************
'도구-참조에서 Microsoft XML 6/5/4 or 3.0 Library 에 반드시 체크할 것!
Const MAIN As Integer = 2 '메인 슬라이드 번호
Sub getWeather()
Dim URL As String
Dim xDoc As MSXML2.DOMDocument
Dim xEntry As MSXML2.IXMLDOMNodeList
Dim xChild As MSXML2.IXMLDOMNode
Dim sld As Slide, shp As Shape
Dim i As Long, j As Long, p As Long
Dim temp() As String, temp_min As String, temp_max As String
Dim sunrise As String, sunset As String, wday As String
URL = "https://weather-broker-cdn.api.bbci.co.uk/en/forecast/rss/3day/1835848" ' BBC 날씨예보
Set xDoc = New MSXML2.DOMDocument
xDoc.async = False
'xDoc.validateOnParse = False
xDoc.Load URL
Set xChild = xDoc.SelectSingleNode("//rss/channel/image/url")
For p = 0 To 3
Set sld = ActivePresentation.Slides(MAIN + p)
Set shp = sld.Shapes("w_icon")
On Error Resume Next
shp.Fill.UserPicture xChild.Text '이미지 없을 경우 에러
On Error GoTo 0
Set xEntry = xDoc.SelectNodes("//rss/channel/item")
i = 0
For Each xChild In xEntry
'<item>
' <title>Saturday: Sunny, Minimum Temperature: -8째C (18째F) Maximum Temperature: 2째C (36째F)</title>
' <link>https://www.bbc.co.uk/weather/1835848?day=1</link>
' <description>Maximum Temperature: 2째C (36째F), Minimum Temperature: -8째C (18째F), Wind Direction: Westerly, Wind Speed: 9mph, Visibility: Good, Pressure: 1025mb, Humidity: 46%, UV Risk: 3, Pollution: -- , Sunrise: 07:21 KST, Sunset: 18:12 KST</description>
' <pubDate>Fri, 15 Feb 2019 12:04:17 GMT</pubDate>
' <guid isPermaLink="false">https://www.bbc.co.uk/weather/1835848-1-2019-02-15T09:00:00.000+0000</guid>
' <dc:date>2019-02-15T12:04:17Z</dc:date>
' <georss:point>37.566 126.9784</georss:point>
'</item>
i = i + 1
wday = "(" & UCase(Left(xChild.SelectSingleNode("title").Text, 3)) & ") "
'최저기온, 최고기온, 일출, 일몰
temp = Split(xChild.SelectSingleNode("description").Text, ", ")
temp_min = "": temp_max = "": sunrise = "": sunset = ""
For j = 0 To UBound(temp)
If InStr(temp(j), "Minimum Temperature: ") > 0 Then temp_min = Split(temp(j), " ")(2)
If InStr(temp(j), "Maximum Temperature: ") > 0 Then temp_max = Split(temp(j), " ")(2)
If InStr(temp(j), "Sunrise: ") > 0 Then sunrise = Split(temp(j), " ")(1)
If InStr(temp(j), "Sunset: ") > 0 Then sunset = Split(temp(j), " ")(1)
Next j
With sld.Shapes("w_day" & i).TextFrame.TextRange
.Text = wday & temp_min & " / " & temp_max
.Font.Color.RGB = rgbOrange
.Characters(7, Len(temp_min) + 2).Font.Color.RGB = rgbWhite
End With
If i = 1 Then
With sld.Shapes("w_sun").TextFrame.TextRange
.Text = ""
If Len(sunrise) Then .Text = "일출: " & sunrise
If Len(sunset) Then .Text = .Text & vbNewLine & "일몰: " & sunset
.Font.Color.RGB = rgbWhite
End With
End If
Next xChild
Next p
Set xDoc = Nothing
End Sub
Sub getNews()
Dim URL As String
Dim xDoc As MSXML2.DOMDocument
Dim xEntry As MSXML2.IXMLDOMNodeList
Dim xChild As MSXML2.IXMLDOMNode
Dim sld As Slide, shp As Shape
Dim i As Long, j As Long, p As Long
Dim temp1 As String, temp2 As String, temp3 As String
URL = "http://fs.jtbc.joins.com//RSS/newsflash.xml" 'newsrank.xml" ' jtbc
Set xDoc = New MSXML2.DOMDocument
If xDoc Is Nothing Then Exit Sub
xDoc.async = False
'xDoc.validateOnParse = False
xDoc.Load URL
For p = 0 To 3
Set sld = ActivePresentation.Slides(MAIN + p)
'날짜, 시간
Set xChild = xDoc.SelectSingleNode("//rss/channel/pubDate")
Set shp = sld.Shapes("n_date")
shp.TextFrame.TextRange = xChild.Text
Next p
Set xEntry = xDoc.SelectNodes("//rss/channel/item")
i = 0: p = 0
For Each xChild In xEntry
'<item>
'<title>[이 시각 뉴스룸] 트럼프, 2차 회담 성공 낙관…"서두를 것 없다"</title>
'<link>
'http://news.jtbc.joins.com/article/article.aspx?news_id=NB11770656
'</link>
'<description>
'1. 트럼프, 2차 회담 성공 낙관…"서두를 것 없다"[앵커]트럼프 미국 대통령이 2차 북미정상회담은 "매우 성공적일 것"이며, "서두를 게 없다"고 낙관했습니다. 북미 양측의 회담 준비팀은 곧 하노이에서 실
'</description>
'<pubDate>2019.02.16</pubDate>
'</item>
Set sld = ActivePresentation.Slides(MAIN + p)
i = i + 1
Set shp = sld.Shapes("n_news_" & i)
'제목
temp1 = xChild.SelectSingleNode("title").Text
'링크
temp2 = xChild.SelectSingleNode("link").Text
'설명
temp3 = xChild.SelectSingleNode("description").Text
With shp.TextFrame.TextRange
.Text = temp1
.Font.Color.RGB = rgbWhite
If InStr(temp1, "[") > 0 Then _
.Characters(1, InStrRev(temp1, "] ")).Font.Color.RGB = rgbOrange
End With
With shp.ActionSettings(ppMouseClick)
.Action = ppActionHyperlink
.Hyperlink.Address = temp2
.Hyperlink.ScreenTip = temp3
End With
If i Mod 5 = 0 Then
i = 0
p = p + 1
'If p > 3 Then Exit For
End If
Next xChild
Set xDoc = Nothing
End Sub
'///// Module 2 ******************************************************
Const MAIN As Long = 2
Sub OnSlideShowPageChange(SSW As SlideShowWindow)
If SSW.View.Slide.SlideIndex = 1 Then
Call getWeather
Call getNews
SSW.View.PointerType = ppSlideShowPointerAlwaysHidden
'SSW.View.GotoSlide MAIN, msoTrue
ElseIf SSW.View.Slide.SlideIndex = MAIN + 4 Then
SSW.View.GotoSlide 1, msoTrue '처음으로 돌아가기
End If
End Sub
weathernewsRSS1.pptm
최근댓글