표(테이블)안의 셀 텍스트에 윤곽선 서식 적용하기

관련: 지식인

 

 

VBA를 이용해서 일반 Shape 개체내의 텍스트에는 아래처럼 윤곽선 서식을 적용할 수 있습니다.

     With shape.TextFrame2.TextRange.Font.Line
            .Visible = msoTrue
            .ForeColor.RGB = RGB(255, 127, 127)
            .Weight = 0.2
     End With

 

그러나 표(테이블)의 텍스트에 위 내용을 적용하면 실제로 적용이 되지 않습니다.

물론 사용자가 마우스로 서식을 적용하면 되긴 하지만 VBA로 이런 작업을 자동화할 수 없게 됩니다.

셀안의 텍스트에 윤곽선 지정, 글자에 그라디언트 색깔 채우기, 3D효과 적용 등이 VBA로는 불가능하게 되어 매우 불편합니다.

 

테이블(표)의 Shape 개체는 일반 슬라이드의 Shape 개체와 똑같지 않고

약간의 속성만 비슷하게 지원해주는 별도의 개체라고 생각해야 합니다.

​

http://www.vbaexpress.com/forum/archive/index.php/t-43787.html

 

위 링크의 답변을 이용해서

1. 임시로 텍스트 상자를 만들고 

2. 각 셀의 텍스트내용을 이 임시 텍스트상자에 붙여넣고 윤곽선을 적용하고 나서

3. 이걸 복사해서 다시 셀에 붙여 넣어주는 방법을 이용할 수 있습니다.

 

 

Option Explicit

Sub test()

    Dim shp As Shape, tshp As Shape
    Dim sld As Slide
    Dim tbl As Table
    Dim r%, c%

    If ActiveWindow.Selection.Type = ppSelectionNone Then MsgBox "표를 선택하세요.": Exit Sub
    Set shp = ActiveWindow.Selection.ShapeRange(1)
    Set sld = shp.Parent
    
    'add a temporary textbox for copying the formatted text into a cell
    Set tshp = sld.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 541, 960, 540)
    tshp.Visible = False
    
    Set tbl = shp.Table
    For r = 1 To tbl.Rows.Count
        For c = 1 To tbl.Columns.Count
            '1) cell -> tshp
            tbl.Cell(r, c).Shape.TextFrame2.TextRange.Copy
            tshp.TextFrame2.TextRange.Paste
            
            '2) outline tshp
            With tshp.TextFrame2.TextRange.Font.Line
                .Visible = msoTrue
                .Weight = 0.2
                .ForeColor.RGB = RGB(255, 127, 127)
            End With
            
            '3) tshp -> cell
            tshp.TextFrame2.TextRange.Copy
            tbl.Cell(r, c).Shape.TextFrame2.TextRange.Paste
            
            '// the code below doesn't work
            'With tbl.Cell(r, c).shape.TextFrame2.TextRange.Characters.Font.Line
            'With tbl.Cell(r, c).shape.TextFrame2.TextRange.Font.Line
            '    .Visible = msoTrue
            '    .Weight = 0.5
            '    .ForeColor.RGB = RGB(255, 127, 127)
            'End With
        Next c
    Next r
    
    'remove the tempoarary textbox
    tshp.Delete

End Sub

 

위 방식을 이용해서 테이블 안의 텍스트에 윤곽선, 3D효과, 그라디언트 채우기 등의 서식을 적용해볼 수 있겠습니다.

 

임시 텍스트 상자의 크기가 작으면 복사/붙여넣기 과정에서 아래로 너무 내려가다보니 오류가 발생할 수 있어서 텍스트 상자 크기를 충분히 크게 바꿨습니다.

 

샘플용 테스트 파일을 첨부합니다.

 

 

OutlinedCellText1.pptm

0.05MB