글자 밑에 밑줄 긋기

 

파워포인트에서 밑줄을 그을 때 기본으로는 글자에 걸쳐서 밑줄이 그어집니다.

 

이 때 글자 아래에 밑줄을 긋고 싶다면 아래 내용을 참고하세요.

 

1. 글꼴 속성에서 '문자높이 일치' 옵션을 켜서 글자위치를 모두 올리는 방법이 있습니다.

​

2. VBA로 선택된 텍스트 아래에 원하는 위치에 밑줄을 그어줄 수도 있습니다.

(Alt-F11 누르고 창이 뜨면 삽입 > 모듈 추가한 다음 아래 코드를 붙여넣고 코드창을 닫고

원하는 텍스트를 드래그하고 Alt-F8로 매크로 실행)

 

Const margin As Single = 5

Sub magicLine()

    Dim tr As TextRange, c1 As TextRange, c2 As TextRange
    Dim x1!, y1!, x2!, y2!
    Dim shp As Shape
    Dim sld As Slide
    
    '현재 선택된 텍스트 영역
    Set tr = ActiveWindow.Selection.TextRange
    Set sld = ActiveWindow.View.Slide
    
    Set c1 = tr.Characters(1)
    Set c2 = tr.Characters(tr.Characters.Count)
    
    x1 = c1.BoundLeft
    y1 = c1.BoundTop + c1.BoundHeight + margin

    x2 = c2.BoundLeft + c2.BoundWidth
    '마지막이 스페이스나 엔터인 경우
    If Asc(c2) = 13 Or Asc(c2) = 32 Then x2 = c2.BoundLeft
    y2 = c2.BoundTop + c2.BoundHeight + margin
    Set shp = sld.Shapes.AddLine(x1, y1, x2, y2)
    shp.Name = "Line_" & shp.Id
    shp.Line.Weight = 5
    shp.Line.ForeColor.RGB = RGB(255, 50, 250)
    shp.Line.DashStyle = msoLineSolid
    
End Sub

Sub removeLines()

    Dim sld As Slide
    Dim l As Long
    
    Set sld = ActiveWindow.View.Slide
    
    For l = sld.Shapes.Count To 1 Step -1
        If sld.Shapes(l).Name Like "Line_*" Then
            sld.Shapes(l).Delete
        End If
    Next l
End Sub

 

실행화면:

 

마우스로 텍스트를 선택할 때 마지막 빈칸이 선택된 경우나 엔터가 있는 경우도 고려했지만

텍스트 드래그 선택은 마우스 보다는 Shift+화살표키로 하세요.

​

샘플 파일 첨부합니다.

 

magicLine1.pptm

0.05MB

 

(지식인 답변 미채택 기념으로 올립니다.)

 

 

https://kin.naver.com/qna/detail.naver?d1id=1&dirId=102020103&docId=469728352&answerNo=1

 

표인 경우를 반영한 수정 버전입니다.

표안의 텍스트인 경우 BoundLeft/Top 에 표도형의 Left, Top 값을 더 추가해주었습니다.

 

코드:

Const margin As Single = 5

Sub magicLine()

    Dim tr As TextRange, c1 As TextRange, c2 As TextRange
    Dim x1!, y1!, x2!, y2!
    Dim shp As Shape
    Dim sld As Slide
    
    '현재 선택된 텍스트 영역
    Set tr = ActiveWindow.Selection.TextRange
    Set sld = ActiveWindow.View.Slide
    Set shp = ActiveWindow.Selection.ShapeRange(1)
    
    Set c1 = tr.Characters(1)
    Set c2 = tr.Characters(tr.Characters.Count)
    
    x1 = c1.BoundLeft
    y1 = c1.BoundTop + c1.BoundHeight + margin
    x2 = c2.BoundLeft + c2.BoundWidth
    
    '마지막이 스페이스나 엔터인 경우
    If Asc(c2) = 13 Or Asc(c2) = 32 Then x2 = c2.BoundLeft
    y2 = c2.BoundTop + c2.BoundHeight + margin
    
    '표인 경우
    If shp.Type = msoTable Then
        y1 = y1 + shp.Top
        y2 = y2 + shp.Top
        x1 = x1 + shp.Left
        x2 = x2 + shp.Left
    End If
    
    '라인 그리기
    Set shp = sld.Shapes.AddLine(x1, y1, x2, y2)
    shp.Name = "Line_" & shp.Id
    shp.Line.Weight = 5
    shp.Line.ForeColor.RGB = RGB(255, 50, 250)
    shp.Line.DashStyle = msoLineSolid
    
End Sub

Sub removeLines()

    Dim sld As Slide
    Dim l As Long
    
    Set sld = ActiveWindow.View.Slide
    
    For l = sld.Shapes.Count To 1 Step -1
        If sld.Shapes(l).Name Like "Line_*" Then
            sld.Shapes(l).Delete
        End If
    Next l
End Sub

Sub t()
    Dim tr As TextRange
    Set tr = ActiveWindow.Selection.TextRange
      
    Debug.Print tr.Characters(tr.Characters.Count), Asc(tr.Characters(tr.Characters.Count))

End Sub

 

수정본:

magicLine2.pptm

0.05MB