글머리 기호 일괄 삭제

- 관련 지식인

 

 

글머리 기호는 영어로 Bullet 입니다.

 

​일반 텍스트나 도형인 경우, 테이블(표)인 경우, 그룹으로 묶인 경우에 내부 도형까지

순환하면서 글머리(Bullet)가 숫자형식이 아닌 경우 모든 글머리를 지우는 매크로입니다.

​

Alt-F8 혹은 개발도구- 매크로 창에서

RemoveBullets_All 은 모든 슬라이드에 대해 처리하고

RemoveBullets_CurrentShape은 현재 선택된 도형에 대해서만 처리합니다.

​

몇가지 경우를 고려하다보니 코드가 조금 길어졌습니다.

Option Explicit

Sub RemoveBullets_All()
    
    Dim oSld As Slide
    Dim oShp As Shape
    
    For Each oSld In ActivePresentation.Slides
        For Each oShp In oSld.Shapes
            If oShp.HasTextFrame Then
                If oShp.TextFrame.HasText Then
                    Call RemoveBullets_Shape(oShp)
                End If
            End If
        Next oShp
    Next oSld

End Sub

Sub RemoveBullets_CurrentShape()

    Dim oShp As Shape
    
    On Error Resume Next
    Set oShp = ActiveWindow.Selection.ShapeRange(1)
    On Error GoTo 0
    
    If oShp Is Nothing Then
        MsgBox "도형을 먼저 선택하세요.", vbExclamation
    Else
        Call RemoveBullets_Shape(oShp)
    End If
    
End Sub

Function RemoveBullets_Shape(shp As Shape)
    
    Dim cShp As Shape
    Dim tr As TextRange
    Dim R As Integer, C As Integer
    
    '그룹도형인 경우
    If shp.Type = msoGroup Then
    
        For Each cShp In shp.GroupItems
            Call RemoveBullets_Shape(cShp)
        Next cShp
        
    '표인 경우
    ElseIf shp.Type = msoTable Then
    
        For R = 1 To shp.Table.Rows.Count
            For C = 1 To shp.Table.Columns.Count
                
                Call RemoveBullets_Shp(shp.Table.Cell(R, C).Shape)
                
            Next C
        Next R
            
    '도형이나 텍스트상자인 경우
    ElseIf shp.Type = msoAutoShape Or shp.Type = msoTextBox Then
    
        Call RemoveBullets_Shp(shp)
    
    End If
    
End Function

Function RemoveBullets_Shp(bshp As Shape)
    
    Dim tr As TextRange
    
    For Each tr In bshp.TextFrame.TextRange.Paragraphs
        With tr.ParagraphFormat.Bullet
        
            '글머리가 숫자가 아니면 지우기
            If Not .Type = ppBulletNumbered Then
                .Type = ppBulletNone
            End If
        
        End With
    Next tr
    
End Function

💡 숫자인 경우를 포함해서 모든 글머리를 지우려면 마지막 부분에서 아래부분(')을 주석처리하세요.

 

'If Not .Type = ppBulletNumbered Then  '//주석 처리
    .Type = ppBulletNone
'End If   '//주석 처리

 

📌첨부파일 사용방법:

먼저 첨부파일을 매크로 허용해서 열고
질문자님의 파일을 연 다음
Alt-F8 매크로 창에서 매크로 위치를 먼저 첨부파일(RemoveBullet1.pptm)으로 지정해서
RemoveBullets_~ 매크로를 실행하면 됩니다.

한 개의 도형에 대해서 처리할 때는 도형을 먼저 선택하고 실행하세요.

 

RemoveBullets1.pptm

0.05MB