PPT 표(Table) 서식 복사/적용

VBA로 특정 테이블의 글꼴, 배경 등 몇몇 주요서식을 복사해서

원하는 테이블에 서식만 복사할 수 있도록 만들어 보았습니다.

첨부한 TableFormatCopy1.pptm을 열고 테스트해보세요.

 

그림처럼 리본메뉴가 생성되는데

Copy Table Format 버튼은 테이블의 서식을 복사합니다.

Paste Table Format 은 복사된 서식을 선택된 테이블에 일괄 적용합니다.

 

현재 테이블의 전체적인 배경,

1행1열의 배경색, 투명도, 글자크기, 한영글꼴, 외곽선, 좌우상하정렬, 좌우여백

1행2열의 배경색, 투명도, 글자크기, 한영글꼴, 외곽선(상하좌우 테두리), 좌우상하정렬, 좌우여백

을 복사합니다.

 

리본메뉴에 기능을 추가한 실행 영상입니다.

 

추가기능으로 이용하려면 첨부한 pptm 을 ppam 형식으로 다시 저장해서 아래처럼 추가기능으로 설치하면

영구적으로 이 리본 메뉴를 이용할 수 있습니다.

질문자님의 PC에만 설치되고 다른 사용자는 매크로를 사용할 필요가 없습니다.

 

소스는 아래와 같습니다.

Option Explicit
 
Public T_Background As TableBackground
 
Public T_Title_Border As Borders
Public T_Title_ForeColor As Long
Public T_Title_ForeColor_Trans As Single
Public T_Title_Font_Name As String
Public T_Title_Font_NameFE As String
Public T_Title_Font_Size As Single
Public T_Title_Font_Color As Long
Public T_Title_Font_Bold As Boolean
Public T_Title_hAlign As Integer
Public T_Title_vAlign As Integer
Public T_Title_lMargin As Single
Public T_Title_rMargin As Single
 
Public T_Sub_Border As Borders
Public T_Sub_ForeColor As Long
Public T_Sub_ForeColor_Trans As Single
Public T_Sub_Font_Name As String
Public T_Sub_Font_NameFE As String
Public T_Sub_Font_Size As Single
Public T_Sub_Font_Color As Long
Public T_Sub_Font_Bold As Boolean
Public T_Sub_hAlign As Integer
Public T_Sub_vAlign As Integer
Public T_Sub_lMargin As Single
Public T_sub_rMargin As Single
 
 
Sub TableFormatCopy()
    Dim Tbl As Table
    Dim r As Long, c As Long
    
    On Error GoTo ErrMsg:
    Set Tbl = ActiveWindow.Selection.ShapeRange(1).Table
    'T_Background_Color = tbl.Background.Fill.ForeColor.RGB
    Set T_Background = Tbl.Background
 
            r = 1: c = 1
                Set T_Title_Border = Tbl.Cell(r, c).Borders
                T_Title_ForeColor = Tbl.Cell(r, c).Shape.Fill.ForeColor.RGB
                T_Title_ForeColor_Trans = Tbl.Cell(r, c).Shape.Fill.Transparency
                T_Title_hAlign = Tbl.Cell(r, c).Shape.TextFrame.TextRange.ParagraphFormat.Alignment
                T_Title_vAlign = Tbl.Cell(r, c).Shape.TextFrame.VerticalAnchor
                T_Title_lMargin = Tbl.Cell(r, c).Shape.TextFrame.MarginLeft
                T_Title_rMargin = Tbl.Cell(r, c).Shape.TextFrame.MarginRight
                
                With Tbl.Cell(r, c).Shape.TextFrame.TextRange.Font
                    T_Title_Font_Name = .Name
                    T_Title_Font_NameFE = .NameFarEast
                    T_Title_Font_Size = .Size
                    T_Title_Font_Color = .Color.RGB
                    T_Title_Font_Bold = .Bold
                End With
            r = 2: c = 1
                Set T_Sub_Border = Tbl.Cell(r, c).Borders
                T_Sub_ForeColor = Tbl.Cell(r, c).Shape.Fill.ForeColor.RGB
                T_Sub_ForeColor_Trans = Tbl.Cell(r, c).Shape.Fill.Transparency
                T_Sub_hAlign = Tbl.Cell(r, c).Shape.TextFrame.TextRange.ParagraphFormat.Alignment
                T_Sub_vAlign = Tbl.Cell(r, c).Shape.TextFrame.VerticalAnchor
                T_Sub_lMargin = Tbl.Cell(r, c).Shape.TextFrame.MarginLeft
                T_sub_rMargin = Tbl.Cell(r, c).Shape.TextFrame.MarginRight
                
                With Tbl.Cell(r, c).Shape.TextFrame.TextRange.Font
                    T_Sub_Font_Name = .Name
                    T_Sub_Font_NameFE = .NameFarEast
                    T_Sub_Font_Size = .Size
                    T_Sub_Font_Color = .Color.RGB
                    T_Sub_Font_Bold = .Bold
                End With
    
    Exit Sub
ErrMsg:
    MsgBox Err.Description, vbCritical
End Sub
 
Sub TableFormatPaste()
    Dim shpRng As Shape
    Dim Tbl As Table
    Dim r As Long, c As Long
    Dim i As Integer
    
    If T_Sub_ForeColor = 0 Then MsgBox "Copy a Table format first": Exit Sub
    
    On Error GoTo ErrMsg:
    For Each shpRng In ActiveWindow.Selection.ShapeRange
        Set Tbl = shpRng.Table
        'T_Background_Color = tbl.Background.Fill.ForeColor.RGB
        Set T_Background = Tbl.Background
        For r = 1 To Tbl.Rows.Count
            For c = 1 To Tbl.Columns.Count
                If r = 1 Then
                    On Error Resume Next
                    'Set tbl.Cell(r, c).Borders = T_Title_Border
                    For i = 1 To T_Title_Border.Count
                        Tbl.Cell(r, c).Borders(i).Visible = T_Title_Border(i).Visible
                        Tbl.Cell(r, c).Borders(i).Weight = T_Title_Border(i).Weight
                        Tbl.Cell(r, c).Borders(i).DashStyle = T_Title_Border(i).DashStyle
                        Tbl.Cell(r, c).Borders(i).ForeColor.RGB = T_Title_Border(i).ForeColor.RGB
                    Next i
                    Tbl.Cell(r, c).Shape.Fill.ForeColor.RGB = T_Title_ForeColor
                    Tbl.Cell(r, c).Shape.Fill.Transparency = T_Title_ForeColor_Trans
                    Tbl.Cell(r, c).Shape.TextFrame.TextRange.ParagraphFormat.Alignment = T_Title_hAlign
                    Tbl.Cell(r, c).Shape.TextFrame.VerticalAnchor = T_Title_vAlign
                    Tbl.Cell(r, c).Shape.TextFrame.MarginLeft = T_Title_lMargin
                    Tbl.Cell(r, c).Shape.TextFrame.MarginRight = T_Title_rMargin
                    With Tbl.Cell(r, c).Shape.TextFrame.TextRange.Font
                        .Name = T_Title_Font_Name
                        .NameFarEast = T_Title_Font_NameFE
                        .Size = T_Title_Font_Size
                        .Color.RGB = T_Title_Font_Color
                        .Bold = T_Title_Font_Bold
                    End With
                Else
                    'Set tbl.Cell(r, c).Borders = T_Sub_Border
                    For i = 1 To T_Sub_Border.Count
                        'tbl.Cell(r, c).Borders(i).Style = T_Sub_Border(i).Style
                        Tbl.Cell(r, c).Borders(i).Visible = T_Sub_Border(i).Visible
                        Tbl.Cell(r, c).Borders(i).Weight = T_Sub_Border(i).Weight
                        Tbl.Cell(r, c).Borders(i).DashStyle = T_Sub_Border(i).DashStyle
                        Tbl.Cell(r, c).Borders(i).ForeColor.RGB = T_Sub_Border(i).ForeColor.RGB
                    Next i
                    Tbl.Cell(r, c).Shape.Fill.ForeColor.RGB = T_Sub_ForeColor
                    Tbl.Cell(r, c).Shape.Fill.Transparency = T_Sub_ForeColor_Trans
                    Tbl.Cell(r, c).Shape.TextFrame.TextRange.ParagraphFormat.Alignment = T_Sub_hAlign
                    Tbl.Cell(r, c).Shape.TextFrame.VerticalAnchor = T_Sub_vAlign
                    Tbl.Cell(r, c).Shape.TextFrame.MarginLeft = T_Sub_lMargin
                    Tbl.Cell(r, c).Shape.TextFrame.MarginRight = T_sub_rMargin
                    With Tbl.Cell(r, c).Shape.TextFrame.TextRange.Font
                        .Name = T_Sub_Font_Name
                        .NameFarEast = T_Sub_Font_NameFE
                        .Size = T_Sub_Font_Size
                        .Color.RGB = T_Sub_Font_Color
                        .Bold = T_Sub_Font_Bold
                    End With
                End If
            Next c
        Next r
    Next shpRng
    
    Exit Sub
ErrMsg:
    MsgBox Err.Description, vbCritical
End Sub
 

 

파일 첨부합니다.

TableFormatCopy1.pptm

0.06MB

 

[2021.12.20] 제목줄과 바로 다음줄 뿐만 아니라 세번째 줄의 서식도 홀짝 번갈아가면 복사하는 버전을 추가합니다.

또한 복사한 테이블 서식을 모든 슬라이드의 테이블에 적용하는 버튼도 추가했습니다.

 

TableFormatCopy2.pptm

0.05MB

 

[2021.12.21] 이전에는 아래의 1,2,3번 영역을 반영했다면 이번에는 제목줄 아래에 2행 이후의 1열들(아래 4번 영역)의 표 속성이 다른 셀들과 다른 경우를 반영한 버전입니다.

 

TableFormatCopy3.pptm

0.05MB

 

[2021.12.27.] 테이블 전체가 아니라 하나의 셀 속성을 복사해서 다른 선택된 셀 들에 복사하거나 혹은 테이블전체에 복사하는 기능을 추가했습니다.

 

 

[2022.02.05.] Table(표)의 Border 와 관련해서 버그가 많네요. 특정 셀의 대각선.Visible 속성이나 선을 보이고 감추는 것과 관련해서 작동하지 않는 경우가 많습니다. 그래서 선을 감출 때 .Visible 속성이 작동하지 않아 .Transparancy 속성의 100으로 주는 경우가 많습니다. 차라리 선이 없는 경우 아예 속성을 부여하지 않는 것이 좋겠습니다.

일단 어찌해서 대체로(?) 작동하게 수정한 버전입니다.

 

TableFormatCopy4.pptm

0.07MB

 

(아래는 추가기능(ppam)으로 변환한 파일입니다. 항상 사용할 수 있는 추가기능으로 사용하는 방법은 위를 참고하세요.)

 

TableFormatCopy4.ppam

0.03MB