PPT의 표(테이블)를 엑셀시트에 일괄 복사

출처: https://konahn.tistory.com/entry/Table2Excel

VBA 처리과정도

마우스로 슬라이드의 표(테이블)을 복사해서 엑셀 시트에 붙여넣는 것과 유사합니다.

​

테이블.Copy 해서 시트의 셀.Paste 하거나 시트.PasteSpecial로 붙여넣습니다.

​

테이블이 여러개 일텐데  아래와 같은 샘플을 만들었습니다.

​

VBA코드:

닫기

	'Copy the table content on each slide to Excel sheet
	Option Explicit
	Const TextOnly As Boolean = False
	Sub CopyTableToSheet()
	Dim xl As Object 'New Excel.Application
	Dim wb As Object 'Excel.Workbook
	Dim sht As Object 'Excel.Worksheet
	Dim rng As Object 'Excel.Range
	Set xl = CreateObject("Excel.Application")
	xl.Visible = True
	Set wb = xl.Workbooks.Add
	Set sht = wb.Worksheets(1)
	Dim pres As Presentation
	Dim sld As Slide
	Dim shp As Shape
	Set pres = ActivePresentation
	'pres.Save
	Set rng = sht.Range("A1")
	For Each sld In pres.Slides
	For Each shp In sld.Shapes
	If shp.Type = msoTable Then
	shp.Copy '테이블(표) 복사
	If TextOnly Then
	rng.Select
	sht.PasteSpecial Format:="HTML", NoHTMLFormatting:=True
	Else
	sht.Paste rng '복사한 테이블 붙여넣기
	End If
	Set rng = rng.Offset(shp.Table.Rows.Count) '다음 셀 위치
	End If
	Next shp
	Next sld
	Set xl = Nothing
	End Sub

 

아래는 실행 영상입니다.

 

아래는 엑셀 결과물입니다.

왼쪽이 TextOnly = False 인 경우이고

오른쪽의 TextOnly = True인 경우입니다.

​

참고로 슬라이드의 표(테이블) 셀을 일일이 엑셀 시트의 셀에 복사하는 예제는 아래와 같습니다.

1슬라이드의 Table 1 이라는 표의 셀들을 엑셀 시트에 그대로 값만 복사합니다.

더보기

	'테이블 셀을 일일이 시트의 셀에 복사
	Sub CopyTableCell()
	Dim xl As Object 'New Excel.Application
	Dim wb As Object 'Excel.Workbook
	Dim sht As Object 'Excel.Worksheet
	Dim rng As Object 'Excel.Range
	Set xl = CreateObject("Excel.Application")
	xl.Visible = True
	Set wb = xl.Workbooks.Add
	Set sht = wb.Worksheets(1)
	Dim pres As Presentation
	Dim sld As Slide
	Dim shp As Shape
	Dim r As Integer, c As Integer
	Set pres = ActivePresentation
	With pres.Slides(1).Shapes("Table 1").Table
	For r = 1 To .Rows.Count
	For c = 1 To .Columns.Count
	sht.Cells(r, c) = .Cell(r, c).Shape.TextFrame.TextRange.Text
	Next c
	Next r
	End With
	Set xl = Nothing
	End Sub

 

pptm 파일 첨부합니다.

출처: https://konahn.tistory.com/entry/Table2Excel [konahn　　　　　　　A PowerPoint VBA Adventurer:티스토리]