PPT 슬라이드내의 글자 사용빈도 통계

관련 질문: https://kin.naver.com/qna/detail.nhn?d1id=1&dirId=102020103&docId=399795292&page=1#answer1 

 

파워포인트의 모든 슬라이드에 사용된 글자의 통계를 내는 매크로입니다.

 

단순 텍스트상자, 표, 도형, 그룹도형 등 텍스트가 있는 개체에 대해

각 글자의 사용빈도를 디버그창(Ctrl-G) 에 출력해줍니다.

 

통계출력(빈도수 내림차순)

 

코드 더보기

Option Explicit

Sub CountChars()

    Dim sld As Slide
    Dim shp As Shape
    '도구-참조에서 Microsoft Scripting Runtime 체크 필수
    Dim d As Dictionary
    'Dim d as Object
    'Set d = CreateObject("Scripting.Dictionary")
    Dim c As String
    Dim p&, l&, n&
    
    Set d = New Dictionary
    
    For Each sld In ActivePresentation.Slides
        For Each shp In sld.Shapes
            Call CountShpChars(shp, d)
        Next shp
    Next sld
    
    SortDict d
    
    For l = 0 To d.Count - 1
        n = AscW(d.Keys(l))
        If n < 0 Then n = n + 65535
        Debug.Print l, d.Keys(l) & "(" & n & ")", d.Items(l)
    Next l

    Set d = Nothing

End Sub

Function CountShpChars(ByVal oShp As Shape, ByRef dic As Object)
    Dim cShp As Shape
    Dim s As Series, pt As Point, ax As Variant
    Dim si As Long, p As Long, pi As Long
    Dim r As Long, c As Long
    If oShp.Type = msoGroup Then
        For Each cShp In oShp.GroupItems
            Call CountShpChars(cShp, dic)
        Next cShp
        
    ElseIf oShp.Type = msoTable Then
    
        For r = 1 To oShp.Table.Rows.Count
            For c = 1 To oShp.Table.Columns.Count
                CountStr oShp.Table.Cell(r, c).Shape.TextFrame.TextRange.Text, dic
            Next c
        Next r
        
    ElseIf oShp.Type = msoChart Then
 
'        CountStr oShp.Chart.ChartTitle.Text, dic '차트제목
'        For Each ax In oShp.Chart.Axes  '축제목
'            If ax.HasTitle Then
'                CountStr ax.AxisTitle.Caption, dic
'            End If
'        Next ax
'
'        For si = 1 To oShp.Chart.SeriesCollection.Count '데이터라벨
'            Set s = oShp.Chart.SeriesCollection(si)
'            CountStr s.Name, dic
'                For p = 1 To s.DataLabels.Count
'                    CountStr s.DataLabels(p).Text, dic
'                    For pi = 1 To s.Points.Count
'                        CountStr s.Points(pi).DataLabel.Text, dic
'                    Next pi
'                Next p
'        Next si
              
    Else
        If oShp.HasTextFrame Then
            If oShp.TextFrame.HasText Then
                CountStr oShp.TextFrame.TextRange.Text, dic
            End If
        End If
        
    End If
    
End Function


Function CountStr(ByVal str As String, ByRef oDic As Object)
    Dim p As Long
    Dim c As String
    
    For p = 1 To Len(str)
        c = Mid(str, p, 1)
        If oDic.Exists(c) Then
            oDic(c) = oDic(c) + 1
        Else
            oDic.Add c, 1
        End If
    Next p
End Function

Function SortDict(ByRef dic As Scripting.Dictionary)
    Dim i As Long
    Dim j As Long
    Dim tmp  As String
    Dim arr() As String
    Dim tmpdic As Scripting.Dictionary
    ' Get out if dictionary is empty
    If dic Is Nothing Then
        Exit Function
    End If
    ' or if it has at most one item
    If dic.Count <= 1 Then
        Exit Function
    End If
    ' Fill arrays with arr
    ReDim arr(0 To dic.Count - 1)
    For i = 0 To dic.Count - 1
        arr(i) = dic.Keys(i)
    Next i
    ' Sort the array
    For i = LBound(arr) To UBound(arr) - 1
        For j = i + 1 To UBound(arr)
            If dic(arr(i)) < dic(arr(j)) Then
                tmp = arr(i)
                arr(i) = arr(j)
                arr(j) = tmp
            End If
        Next j
    Next i
    ' Fill new dictionary with the sorted keys
    Set tmpdic = New Scripting.Dictionary
    For i = 0 To dic.Count - 1
        tmpdic.Add Key:=arr(i), Item:=dic(arr(i))
    Next i
    ' Set original dictionary to temp one
    Set dic = tmpdic
End Function

 

차트는 제외했는데 주석을 제거하면 차트안의 텍스트도 통계에 포함됩니다.

 

위 코드에는 Dictionary 가 사용되었는데

도구-참조에서 Microsoft Scripting Runtime 라이브러리를 반드시 체크해주세요.

특히 Dictionary 데이터를 Value 를 기준으로 정렬하는 것도 들어 있습니다.

각 Key값을 배열에 저장해놓고 Dictionary의 값에 따라 Key값을 정렬해서 먼저 들어간 Key값의 Value 부터 먼저 출력하는 방식입니다.

 

테스트파일 참고하세요.

글자수2.pptm

0.07MB