[GeoJson2PPTx] 지도용 GeoJson파일을 Pptx로 변환

 

 

우리나라 행정동과 세계지도를 pptx로 변환하는데 사용된 VBA함수들입니다. 지도의 경계구역을 벡터 좌표로 저장한 GeoJson파일을 SVG이미지로 변환한 뒤에 ppt에 불러와서 다시 ppt도형으로 변환하고 도형에 이름을 부여하고 그룹으로 묶을 때 사용된 VBA를 모은 것입니다. 

 

자세한 내용은 아래 설명을 참고하세요.

 

우리나라 행정동의 경우 

원본 GeoJson 데이터를 SortGeoJson으로 정렬한 다음

SplitGeoJson으로 도시별로 json 데이터를 별도의 파일로 나누었습니다.

그리고 json데이터를 mapshaper 사이트에서 SVG로 변환하였습니다.

그 다음 Batch_행정동 경계지도를 실행하였습니다.

 

내부적인 일괄처리 순서는

지역별 SVG데이터를 선택하면 해당 이미지를 슬라이드에 가득차게 불러오고

오피스 도형으로 변환 후에 그룹을 해제합니다.

그 다음 Json 파일을 선택하면 각 동이름을 지정하고

ColorDong으로 색깔을 랜덤으로 지정하고

GroupDong으로 구별로 그룹처리합니다.

또한 GrayDong으로 색깔을 무채색으로 변환한 슬라이드도 추가됩니다.

 

주의)

- ColorDong 은 그룹으로 묶기 전에 실행하기 바랍니다. 구별로 그룹으로 묶은 다음에 실행하면 동별로는 색깔이 같고 구그룹별로 색깔이 달라집니다.

- 세계지도 도형조각들에 대해 세계지도json파일을 불러와서 이름을 부여할 때

MultiShapeMode가 기본으로 False인 상태인데 만약 한 나라의 도형이 여러개의 도형인 경우 True로 바꿔줘야 합니다.

- JSON데이터나 SVG용량이 크면 작업시간이 오래 걸릴 수 있습니다. JSON데이터 정렬작업도 오래 걸릴 수 있습니다. 우리나라 전체 지도도 작업이 오래 걸립니다. 그래서 우리나라 지도의 경우 각 도시별로 json 데이터를 분리한 다음 지역별로 작업을 처리했습니다. 

 

 

Option Explicit

'adm_cd 기준으로 우리나라 행정구역GeoJson 아이템 정렬
Private Sub SortGeoJson()

    Dim target As String
    'target = ActivePresentation.Path & "\HangJeongDong_ver20220101.geojson"
    With Application.FileDialog(msoFileDialogOpen)
        .Filters.Clear
        .Filters.Add "json file", "*.*json"
        .InitialFileName = ActivePresentation.Path & "\"
        .AllowMultiSelect = False
        .Title = "행정구역이 담긴 geojson 파일 선택"
        If .Show = -1 Then target = .SelectedItems(1)
    End With
    If target = "" Then Exit Sub
    
    Dim Json As New Dictionary, ele As New Dictionary, header As New Dictionary
    Dim FSO As New FileSystemObject
    Dim str As Object
    Dim buffer As String
    Dim i As Integer, j As Integer, t As Integer, total As Integer
    Dim arr() As Integer
    
    Set str = FSO.OpenTextFile(target, ForReading)
    If str Is Nothing Then Exit Sub
    
    Debug.Print Now, "JSON parsing started"
    buffer = str.ReadAll
    Set Json = ParseJson(buffer)
    str.Close
    
    Debug.Print Now, "Sorting started"
    '모든 시도 순환
    total = Json("features").Count
    'total = 50

    ReDim arr(1 To total)
    For i = LBound(arr) To total
        arr(i) = i
    Next i
    
        header.RemoveAll
        header.Add "type", Json("type")
        header.Add "name", Json("name")
        header.Add "crs", Json("crs")
        header.Add "features", ""
        'buffer = "{" & vbNewLine & ConvertToJson(header, 4) & vbNewLine & """features"": ["
        buffer = VBAJSON.ConvertToJson(header)
        buffer = Left(buffer, Len(buffer) - 3) & " [" & vbNewLine
        
        ' 행  순환
        For i = 1 To total
            For j = 1 To total
            
                If Json("features")(arr(i))("properties")("adm_cd") < Json("features")(arr(j))("properties")("adm_cd") Then
                    t = arr(i)
                    arr(i) = arr(j)
                    arr(j) = t
                End If
                
            Next j
        Next i
        
        Debug.Print Now(), total; " items sorted"
        
        For i = 1 To total
            buffer = buffer & IIf(i = 1, "", "," & vbNewLine) & VBAJSON.ConvertToJson(Json("features")(arr(i)))
        Next i
        
        target = Left(target, InStrRev(target, ".") - 1) & "_sorted.json"
        Set str = FSO.OpenTextFile(target, ForWriting, True)
        buffer = buffer & vbNewLine & "]" & vbNewLine & "}"
        str.Write buffer
        str.Close
        Debug.Print Now(), "Finished to write to ", target
  
    Set Json = Nothing
    Set FSO = Nothing
End Sub

'GeoJson 파일 행정구역별로 파일 나누기
Private Sub SplitGeoJson()

    Dim target As String
    'target = ActivePresentation.Path & "\HangJeongDong_ver20220101.geojson"
    With Application.FileDialog(msoFileDialogOpen)
        .Filters.Clear
        .Filters.Add "json file", "*.*json"
        .InitialFileName = ActivePresentation.Path & "\"
        .AllowMultiSelect = False
        .Title = "행정구역이 담긴 geojson 파일 선택"
        If .Show = -1 Then target = .SelectedItems(1)
    End With
    If target = "" Then Exit Sub

    
    Dim Json As New Dictionary, ele As New Dictionary, header As New Dictionary
    Dim FSO As New FileSystemObject
    Dim str As Object
    Dim buffer As String
    Dim sido() As Variant, sidonm As String
    Dim i As Integer, j As Integer
    
    Set str = FSO.OpenTextFile(target, ForReading)
    If str Is Nothing Then Exit Sub
    buffer = str.ReadAll
    Set Json = ParseJson(buffer)
    str.Close

    'For Each ele In Json("features")
    '    If Not sido.Exists(ele("properties")("sido")) Then
    '        sido.Add ele("properties")("sido"), l
    '    End If
    'Next ele
    
    ReDim sido(17)
    sido = Array(11, 26, 27, 28, 29, 30, 31, 36, 41, 42, 43, 44, 45, 46, 47, 48, 50)
    
    '모든 시도 순환
    For i = 0 To UBound(sido)
        header.RemoveAll
        header.Add "type", Json("type")
        header.Add "name", Json("name")
        header.Add "crs", Json("crs")
        header.Add "features", ""
        'buffer = "{" & vbNewLine & ConvertToJson(header, 4) & vbNewLine & """features"": ["
        buffer = VBAJSON.ConvertToJson(header)
        buffer = Left(buffer, Len(buffer) - 3) & " [" & vbNewLine
        
        j = 0
        '모든 행 순환
        For Each ele In Json("features")
            If ele("properties")("sido") = CStr(sido(i)) Then
                sidonm = ele("properties")("sidonm")
                buffer = buffer & IIf(j = 0, "", "," & vbNewLine) & VBAJSON.ConvertToJson(ele)
                j = j + 1
            End If
        Next ele
        
        If j Then
            target = Left(target, InStrRev(target, "\")) & sido(i) & "_" & sidonm & ".json"
            Set str = FSO.OpenTextFile(target, ForWriting, True)
            buffer = buffer & vbNewLine & "]" & vbNewLine & "}"
            str.Write buffer
            str.Close
        End If
    Next i
    Set Json = Nothing
    Set FSO = Nothing
End Sub

Private Sub NameDongXLSX()

    Dim xlApp As New Excel.Application
    Dim sht As Excel.Worksheet
    Dim rng As Excel.Range
    Dim target As String
    
    target = ActivePresentation.Path & "\서울특별시.xlsx"
    Set sht = xlApp.Workbooks.Open(target).Worksheets(1)
    If sht Is Nothing Then Exit Sub
    
    Dim sld As Slide
    Dim shp As Shape
    Dim i As Integer

    Set sld = ActiveWindow.View.Slide
    
    For Each shp In sld.Shapes
        If shp.Visible = msoTrue And shp.Type = msoFreeform Then
            i = i + 1
            shp.Name = sht.Cells(i, "A")
            
        End If
    Next shp
    
    xlApp.Quit
     
End Sub

'세계지도 이름 부여
Private Sub NameShapeJSON()

    Dim Json As New Dictionary, ele As New Dictionary
    Dim FSO As New FileSystemObject
    Dim target As String
    Dim str As Object
    Dim buffer As String
    Dim MultiShapeMode As Boolean
    
    With Application.FileDialog(msoFileDialogOpen)
        .Filters.Clear
        .Filters.Add "json file", "*.*json"
        .InitialFileName = ActivePresentation.Path & "\"
        .AllowMultiSelect = False
        .Title = "이름이 담긴 json 파일 선택"
        If .Show = -1 Then target = .SelectedItems(1)
    End With
    If target = "" Then Exit Sub
    
    Set str = FSO.OpenTextFile(target, ForReading)
    If str Is Nothing Then Exit Sub
    buffer = str.ReadAll
    Set Json = ParseJson(buffer)
    str.Close
        
    If MsgBox("MultiPolygon모드(한 나라의 도형이 여러개로 나뉜 경우)를 사용할까요?", _
        vbYesNo, "MultiPolygon Mode") = vbYes Then MultiShapeMode = True
        
    Dim sld As Slide
    Dim shp As Shape
    Dim i As Integer, j As Integer

    Set sld = ActiveWindow.View.Slide
    
    'Debug.Print Json("features").Count
    For Each ele In Json("features")
        
        If ele("geometry")("type") = "MultiPolygon" And MultiShapeMode Then
            For i = 1 To ele("geometry")("coordinates").Count
                j = j + 1
                sld.Shapes(j).Name = ele("properties")("name") & " / " & i
            Next i
        Else    '"Polygon"
            j = j + 1
            sld.Shapes(j).Name = ele("properties")("name")
            'sld.Shapes(j).Name = ele("properties")("ADMIN")
        End If
    Next ele
    
    Set Json = Nothing
     
End Sub

'세계지도 도형 그룹
Private Sub GroupShape()

    Dim sld As Slide
    Dim shp As Shape
    Dim pCoun As String, nCoun As String
    Dim l As Integer, p As Integer
    
    Set sld = ActiveWindow.View.Slide
    Windows(1).Selection.Unselect
    
    For l = sld.Shapes.Count To 1 Step -1
        Set shp = sld.Shapes(l)
        If shp.Visible = msoTrue And shp.Type = msoFreeform Then
            p = InStrRev(shp.Name, " / ")
            If p > 0 Then
                nCoun = Left(shp.Name, p - 1)
            Else
                nCoun = shp.Name
            End If
            
            If nCoun = pCoun Then
                shp.Select msoFalse
            Else
                On Error Resume Next
                With ActiveWindow.Selection.ShapeRange
                    If .Count > 1 Then .Group.Name = pCoun
                End With
                On Error GoTo 0
                shp.Select msoTrue
            End If
            pCoun = nCoun

        End If
    Next l
    
    'last group
    On Error Resume Next
    With ActiveWindow.Selection.ShapeRange
        If .Count > 1 Then .Group.Name = pCoun
    End With
    On Error GoTo 0
    
End Sub

Sub Batch_행정동경계지도()

    Dim pres As Presentation
    Dim osld As Slide, nsld As Slide
    Dim shp As Shape
    Dim target As String
    Dim SW!, SH!
    
    Set pres = ActivePresentation
    '1슬라이드
    Set osld = ActiveWindow.View.Slide
    With Application.FileDialog(msoFileDialogOpen)
        .Filters.Clear
        .Filters.Add "SVG file", "*.svg"
        .InitialFileName = ActivePresentation.Path & "\"
        .AllowMultiSelect = False
        .Title = "지도 SVG 파일 선택"
        If .Show = -1 Then target = .SelectedItems(1)
    End With
    If target = "" Then Exit Sub
    SW = pres.PageSetup.SlideWidth
    SH = pres.PageSetup.SlideHeight
    Set shp = osld.Shapes.AddPicture(target, 0, 1, 0, 0, SW, SH)
    shp.ScaleWidth 1, msoTrue
    shp.ScaleHeight 1, msoTrue
    shp.LockAspectRatio = msoTrue
    If shp.Width > shp.Height Then
        shp.Width = SW
        If shp.Height > SH Then shp.Height = SH
    Else
        shp.Height = SH
        If shp.Width > SW Then shp.Width = SW
    End If
    shp.Left = SW / 2 - shp.Width / 2
    shp.Top = SH / 2 - shp.Height / 2
    shp.Select
    
    If MsgBox("계속할까요?", vbOKCancel) = vbCancel Then Exit Sub
    Call CommandBars.ExecuteMso("SVGEdit")
    Set shp = osld.Shapes(osld.Shapes.Count)
    shp.Select
    shp.Ungroup
    
    '동 이름지정
    Call NameDongJSON
    '동 랜덤 색상
    Call ColorDong
    
    '2슬라이드 회색조
    'Set osld = ActivePresentation.Slides(osld.SlideIndex)
    Set nsld = osld.Duplicate(1)
    nsld.Select
    Call GrayColorDong
    
    '3슬라이드 백지도
    Set osld = nsld.Duplicate(1)
    'Windows(1).Selection.Unselect
    osld.Select
    Call ShapeLine
    Call GroupDong
    
    '2슬라이드 동 그룹
    pres.Slides(osld.SlideIndex - 1).Select
    GroupDong
    
    '1슬라이드 동 그룹
    pres.Slides(osld.SlideIndex - 2).Select
    GroupDong
    

End Sub

' 도형 경계선 추가
Private Sub ShapeLine()
    Dim psld As Slide
    Dim shp As Shape
    
    Set psld = ActiveWindow.View.Slide
    For Each shp In psld.Shapes
        If shp.Type = msoFreeform Then
            shp.Fill.Visible = msoFalse
            shp.Line.Visible = msoTrue
            shp.Line.ForeColor.RGB = RGB(60, 63, 90)  'rgbGray
            shp.Line.Weight = 0.1
        End If
    Next shp
End Sub

'우리나라 행정동 이름부여
Private Sub NameDongJSON()

    Dim Json As New Dictionary
    Dim FSO As New FileSystemObject
    Dim target As String
    Dim str As Object
    Dim buffer As String
    
    'target = ActivePresentation.Path & "\경주시.json"
    With Application.FileDialog(msoFileDialogOpen)
        .Filters.Clear
        .Filters.Add "json file", "*.*json"
        .InitialFileName = ActivePresentation.Path & "\"
        .AllowMultiSelect = False
        .Title = "이름이 담긴 json 파일 선택"
        If .Show = -1 Then target = .SelectedItems(1)
    End With
    If target = "" Then Exit Sub
    
    Set str = FSO.OpenTextFile(target, ForReading)
    If str Is Nothing Then Exit Sub
    buffer = str.ReadAll
    Set Json = ParseJson(buffer)
    str.Close
        
    Dim sld As Slide
    Dim shp As Shape
    Dim i As Integer

    Set sld = ActiveWindow.View.Slide
    
    For Each shp In sld.Shapes
        If shp.Visible = msoTrue And shp.Type = msoFreeform Then
            i = i + 1
            'shp.Name = Json("features")(i)("properties")("temp")
            shp.Name = Json("features")(i)("properties")("adm_nm")
        End If
    Next shp
    
    Set Json = Nothing
     
End Sub

'우리나라 행정동/면 그룹
Private Sub GroupDong()

    Dim sld As Slide
    Dim shp As Shape
    Dim pGu As String, nGu As String
    Dim l As Long
    
    Set sld = ActiveWindow.View.Slide
    Windows(1).Selection.Unselect
    
    For l = sld.Shapes.Count To 1 Step -1
        Set shp = sld.Shapes(l)
        If shp.Visible = msoTrue And shp.Type = msoFreeform Then
        
            nGu = Left(shp.Name, InStrRev(shp.Name, " ") - 1)
            If nGu = pGu Then
                shp.Select msoFalse
            Else
                On Error Resume Next
                With ActiveWindow.Selection.ShapeRange
                    If .Count > 1 Then .Group.Name = pGu
                End With
                On Error GoTo 0
                shp.Select msoTrue
            End If
            pGu = nGu
        End If
    Next l
    
    'last group
    On Error Resume Next
    With ActiveWindow.Selection.ShapeRange
        If .Count > 1 Then .Group.Name = pGu
    End With
    On Error GoTo 0
    
End Sub

'우리나라 행정동 시도 그룹
Private Sub GroupSiDo()

    Dim sld As Slide
    Dim shp As Shape
    Dim pGu As String, nGu As String
    Dim l As Long
    
    Set sld = ActiveWindow.View.Slide
    Windows(1).Selection.Unselect
    
    For l = sld.Shapes.Count To 1 Step -1
        Set shp = sld.Shapes(l)
        If shp.Visible = msoTrue And shp.Type = msoGroup Then
        
            nGu = Left(shp.Name, InStr(shp.Name, " ") - 1)
            If nGu = pGu Then
                shp.Select msoFalse
            Else
                On Error Resume Next
                With ActiveWindow.Selection.ShapeRange
                    If .Count > 1 Then .Group.Name = pGu
                End With
                On Error GoTo 0
                shp.Select msoTrue
            End If
            pGu = nGu
        End If
    Next l
    
    'last group
    On Error Resume Next
    With ActiveWindow.Selection.ShapeRange
        If .Count > 1 Then .Group.Name = pGu
    End With
    On Error GoTo 0
    
End Sub

Private Sub ColorDong()

    Dim sld As Slide
    Dim shp As Shape
    Dim i As Integer

    Set sld = ActiveWindow.View.Slide
    
    For Each shp In sld.Shapes
        If shp.Visible = msoTrue And (shp.Type = msoFreeform Or shp.Type = msoGroup) Then
            
            shp.Fill.ForeColor.RGB = RGB(Int(Rnd * 128) + 128, Int(Rnd * 128) + 128, Int(Rnd * 128) + 128)
            
        End If
    Next shp

End Sub

Private Sub GrayColorDong()

    Dim sld As Slide
    Dim shp As Shape, cshp As Shape
    Dim i As Integer

    Set sld = ActiveWindow.View.Slide
    
    For Each shp In sld.Shapes
        If shp.Visible = msoTrue And (shp.Type = msoFreeform Or shp.Type = msoGroup) Then
            
            shp.Fill.ForeColor.RGB = Grayscale(shp.Fill.ForeColor.RGB)
        ElseIf shp.Type = msoGroup And Right(shp.Name, 1) = "구" Then
            For Each cshp In shp.GroupItems
                cshp.Fill.ForeColor.RGB = Grayscale(cshp.Fill.ForeColor.RGB)
            Next cshp
        End If
    Next shp

End Sub

Function Grayscale(color) As Long
    
    Dim r As Long, g As Long, b As Long
    r = (color \ 256 ^ 0 And 255) * 0.287
    g = (color \ 256 ^ 1 And 255) * 0.589
    b = (color \ 256 ^ 2 And 255) * 0.114
    Grayscale = RGB(r + g + b, r + g + b, r + g + b)
    
 End Function

 

json 처리는 VBAJSON 라이브러리를 이용하였습니다.

 

지도_GeoJson2PPTx.pptm

0.28MB

 

우리나라 행정동 GeoJson 파일: https://github.com/vuski/admdongkor

위 데이터를 지역별로 다시 정렬한 json 파일(합본):

00_SKorea_ver20220101ansi_sorted.zip

9.62MB

도시별로 분리한 json 파일:

00_지역별json.zip

9.75MB

우리나라 행정동경계지도 자동으로 만드는 방법:

GeoJson2PPTx.pptm 을 매크로 허용해서 열고 빈 슬라이드를 추가한 다음 Alt-F8을 누르고 'Batch_행정동경계' 를 실행하고 부산광역시.svg와 부산광역시.json 파일을 차례로 선택하면 지도와 행정동경계이름을 붙여서 칼라, 회색, 백지도 순으로 3가지 슬라이드를 만들어 줍니다.

 

세계지도 GeoJson 파일1: https://github.com/MohamedAkbarally/GEOJSONtoSVG

 

세계지도 GeoJson 파일2: https://github.com/w8r/geojson2svg