파워포인트 표의 기존 서식을 유지하면서 엑셀 표 붙여넣기

 

 

 

 

엑셀 영역을 복사해서 파워포인트 표에 Ctrl+V, 대상 스타일 사용 혹은 원본 스타일 유지로 붙여넣으면

아래처럼 기존 파워포인트 표안의 셀의 배경이나 윤곽선 서식은 유지하지만

나머지 기존 텍스트의 폰트설정, 글자크기나 색상, 글자배경색, 글자 정렬은 속성을 모두 잃어버리게 됩니다.

즉, 표의 셀속성은 유지하지만 셀 안의 글자 속성은 유지하지 않습니다.

 

슬라이드 표안의 기존 글자 속성이 모두 사라지므로

붙여넣기 후에 글자 속성을 다시 적용해야하는 번거로움이 발생합니다.

 

이 때 다른 방법으로 Ctrl+Alt+V 선택하여 붙여넣기로

HTML형식이나 서식없는 RTF 형식 등으로 붙여넣어도 해결할 수 없습니다.

 

 

서식없는 Text형식으로 붙여넣으면 셀 하나에 내용이 다 들어가버립니다.

​

 

---

 

 

 

이럴 때 파워포인트 테이블에 클립보드의 엑셀내용을

서식 없이 내용값만 파워포인트 각 셀에 붙여넣는 VBA코드를 만들어 보았습니다.

​

첨부파일을 파일속성에서 '차단해제' 설정하고 파일 열 때 매크로를 허용해서 여세요.

 

먼저 엑셀창의 값들을 Ctrl+C로 복사하고

첨부파일 파워포인트 슬라이드에서 아무 셀이나 선택합니다.

​

아래의 경우 테이블의 1행 2열을 선택한 상태에서

Alt+F8 누르고 PasteIntoCellsAsRawText 를 실행합니다.

 

​

그러면 원래 슬라이드 표의 각종 서식은 유지하면서

엑셀내용을 값만 붙여넣어줍니다.

 

 

테이블의 셀 속성(셀 색깔, 윤곽선 등)뿐만 아니라

폰트, 크기, 글자색/배경, 글자 정렬 등 텍스트의 서식 또한 유지가 되고 있습니다.

​

원본 서식과 나중 서식을 비교해보면 변하지 않았습니다.

​

내부적인 처리과정을 살펴보자면,​

 

클립보드상의 내용은 텍스트로 가져오면

열은 <탭>으로 구분되고

행은 <엔터>로 구분됩니다.

​

위의 경우 클립보드에서 가져온 내용의 구조는

123<탭>123<엔터>

2343<탭>2,343<탭>-<엔터>

...

이런 식으로 구성되어 있습니다.

​

이 매크로는 이러한 클립보드 내용을 <탭>과 <엔터>를 이용해서 행열을 구분해서

슬라이드의 표 안에 현재 선택된 셀 위치에 각각 붙여넣어줍니다.

​

구체적인 코드는 아래와 같습니다.

Option Explicit
Option Base 0

Sub PasteIntoCellsAsRawText()
    'On Error Resume Next
    
    Dim ClipText As String, buf$(), cuf$(), arr$()
    Dim TShp As Shape, shp As Shape
    Dim r%, c%, i%, j%, Found As Boolean
    
    '현재 선택된 도형
    Set TShp = ActiveWindow.Selection.ShapeRange(1)
    If TShp Is Nothing Then Exit Sub
    If TShp.Type <> msoTable Then Exit Sub
    
    '클립보드 내용 가져오기
    ClipText = GetCB
    'Debug.Print ClipText
    If Len(ClipText) = 0 Then MsgBox "클립보드가 비어 있음.": Exit Sub
    
    '클립보드안 표의 행열 개수 파악
    buf() = Split(ClipText, vbCrLf)
    r = UBound(buf)
    cuf() = Split(buf(LBound(buf)), vbTab)
    c = UBound(cuf)
    Debug.Print "Array Size: ", r, c
    
    '클립보드 내용 배열화
    ReDim arr(r, c)
    For i = LBound(buf) To UBound(buf)
        cuf() = Split(buf(i), vbTab)
        For j = LBound(cuf) To UBound(cuf)
            arr(i, j) = cuf(j)
        Next j
    Next i
    
    '붙여넣기 시작할 위치(현재 선택된 첫번째 셀) 찾기
    With TShp.Table
        For r = 1 To .Rows.Count
            For c = 1 To .Columns.Count
                If .Cell(r, c).Selected Then
                    Debug.Print "Starting at: ", r, c
                    Found = True
                    Exit For
                End If
            Next c
            If Found Then Exit For
        Next r
    End With
   
   '표의 셀에 값 넣기
    If Not Found Then Exit Sub
    With TShp.Table
        For i = LBound(arr) To UBound(arr)
            For j = LBound(arr, 2) To UBound(arr, 2)
                If r + i <= .Rows.Count And c + j <= .Columns.Count Then _
                    .Cell(r + i, c + j).Shape.TextFrame.TextRange.Text = arr(i, j)
            Next j
        Next i
    End With

End Sub

'// 클립보드의 텍스트 읽기
Public Function GetCB$()
    On Error GoTo nErr
    Dim Clipboard As Object
'    Microsoft Forms 2.0 Object Library
    Set Clipboard = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    Clipboard.GetFromClipboard
    GetCB = Clipboard.GetText
nErr:
End Function
 
'// 클립보드에 텍스트 쓰기
Public Function SetCB(ByRef sText As String) As Boolean ' ### 리턴값: 성공 여부
    On Error GoTo nErr
    Dim Clipboard As Object
'    Microsoft Forms 2.0 Object Library
    Set Clipboard = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    Clipboard.SetText sText
    Clipboard.PutInClipboard
    SetCB = True
nErr:
End Function

 

새로운 ppt 파일에 적용하려면

Alt+F11 창에 삽입 > 모듈 추가한 후에 위 코드를 붙여넣으세요.

 

그리고 빠른 실행에 추가하면 좋습니다.

 

다른 파일을 열고 매크로를 실행하고 싶다면 이 매크로 파일이 열려 있어야 합니다.

​

엑셀 영역을 복사하고 파워포인트 슬라이드의 테이블에서 원하는 위치를 선택하고

Alt+F8이나 Alt+숫자키(빠른 실행에 등록한 경우)를 누르면 됩니다.

​

 

주의사항:

<탭>과 <엔터>로 구분하기 때문에

기존 엑셀 표상에 이런 문자가 들어 있다면

파워포인트 표에 붙여넣을 때 다른 셀에 값이 들어갈 수 있습니다.

 

 

---

 

 

이런 경우까지 반영하려면

클립보드를 임시 표에 붙여넣은 후

그 표에서 문자열을 가져오고 임시 표는 나중에 삭제하는 방법을 이용해야겠습니다.

 

수정된 코드입니다. 코드가 더 짧고 클립보드 관련 코드가 없어도 됩니다.

'슬라이드에 임시 표로 붙여넣은 후 현재 표에 가져오는 방식
Sub PasteIntoCellsAsRawText2()
    'On Error Resume Next
    
    Dim TShp As Shape, shp As Shape, T2Shp As Shape, sld As Slide
    Dim r%, c%, i%, j%, Found As Boolean
    
    '현재 선택된 도형
    Set TShp = ActiveWindow.Selection.ShapeRange(1)
    If TShp Is Nothing Then Exit Sub
    If TShp.Type <> msoTable Then Exit Sub
     
    '붙여넣기 시작할 위치(현재 선택된 첫번째 셀) 찾아 기억하기
    With TShp.Table
        For r = 1 To .Rows.Count
            For c = 1 To .Columns.Count
                If .Cell(r, c).Selected Then
                    'Debug.Print "Starting at: ", r, c
                    Found = True
                    Exit For
                End If
            Next c
            If Found Then Exit For
        Next r
    End With
    If Not Found Then Exit Sub
    
    On Error Resume Next
    Set sld = ActiveWindow.View.Slide
    On Error GoTo 0
    If sld Is Nothing Then Exit Sub
    
    '슬라이드에 임시 표로 붙여넣기
    Set T2Shp = sld.Shapes.PasteSpecial(ppPasteHTML)(1)
    If T2Shp Is Nothing Then MsgBox "붙여넣기 에러": Exit Sub
    
   '현재 표의 셀에 값 넣기
    With TShp.Table
        For i = 1 To T2Shp.Table.Rows.Count
            For j = 1 To T2Shp.Table.Columns.Count
                If r + i - 1 <= .Rows.Count And c + j - 1 <= .Columns.Count Then _
                    .Cell(r + i - 1, c + j - 1).Shape.TextFrame.TextRange.Text = T2Shp.Table.Cell(i, j).Shape.TextFrame.TextRange.Text
            Next j
        Next i
    End With

    '임시 표 삭제
    T2Shp.Delete
    
End Sub

 

이번에는 PasteIntoCellsAsRawText2 를 실행하세요.

 

 

 

샘플파일 참고하세요.

PasteIntoTableAsRaw1.pptm

0.06MB

 

 

 

 

참고: 지식인