6월 7 2016
엑셀(EXCEL) – 엑셀 시트의 모든 차트를 PPT 슬라이드에 하나씩 혹은 여러장씩 붙여넣기
이 팁의 시작은 아래의 질문을 해결하는 방법을 구걸로 아이디어를 찾는 것이었는데
http://www.clien.net/cs2/bbs/board.php?bo_table=kin&wr_id=3738549
엑셀 그래프를 자동으로 파워포인트로 옮겨주는 VBA나 매크로
비슷한 시기에 비슷한 내요의 질문이 올라와서 이것을 해결하는데 시간이 많이 걸렸네요.
아직도 9개 이상의 차트를 옮기면 슬라이드 하나에 붙여넣기를 해서 해결을 못했습니다.
며칠을 고민해도 차트 오브젝트를 추가 슬라이드에 복사하는 아이디어가 안 떠오르네요.
http://www.clien.net/cs2/bbs/board.php?bo_table=kin&wr_id=3741003
그래프 a4용지 사이즈에 이쁘게 넣는 방법 없을까요?
그냥 슬라이드 하나에 차트 옮기는 것은 쉬운데 하나에 여러 차트를 보기좋게 정렬까지는
할 수 있는데 차트의 갯수가 한 슬라이드의 기본 차트보다 많아지면 문제가 생기네요.
능력자들을 믿습니다. 해결 방법을 댓글로 주세요. 여기까지도 요령껏 사용하면 괜찮아요.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 |
Option Explicit ' 아래 루틴들은 Microsoft PowerPoint xx.x Object Library.를 필요로 함 ' xx.x 는 office version에 따라 참조되는 기준 (11.0 = 2003, 12.0 = 2007 and 14.0 = 2010). ' 아래 루틴에서 참조되는 전역 변수 선언 Dim pptApp As PowerPoint.Application Dim pptPres As PowerPoint.Presentation Dim pptSlide As PowerPoint.Slide Dim pptSlideCount As Integer Dim cntCht As Integer Private Sub ToPPTSlide() ' 워크 시트에 존재하는 모든 chart를 새 파워포인트 슬라이드로 옮김 Dim sht As Worksheet Dim objCht As Object Dim j As Integer, Unit As Integer, i As Integer Dim row As Integer, col As Integer Dim chtTitle As String ' 속도를 위해 화면 갱신 중지 Application.ScreenUpdating = False ' 워크북에 존재하는 chart의 갯수를 셈. For Each sht In ActiveWorkbook.Worksheets cntCht = cntCht + sht.ChartObjects.Count Next sht ' chart가 없을 경우 에러 메시지 If cntCht + ActiveWorkbook.Charts.Count < 1 Then MsgBox " 내보내기 할 차트가 없습니다!", vbCritical, "경 고" Exit Sub End If ' 열려있는 파워포인트가 있는지 체크 On Error Resume Next Set pptApp = GetObject(, "PowerPoint.Application") On Error GoTo 0 ' 파워포인트 실행하고 프리젠테이션 생성 If pptApp Is Nothing Then Set pptApp = New PowerPoint.Application Set pptPres = pptApp.Presentations.Add ' 슬라이드 수를 세고 뒤에 하나 더 추가 pptSlideCount = pptPres.Slides.Count Set pptSlide = pptPres.Slides.Add(pptSlideCount + 1, ppLayoutBlank) ' 워크시트에 존재하는 모든 차트를 내보냄 For Each sht In ActiveWorkbook.Worksheets For Each objCht In sht.ChartObjects Call ToPPT(objCht.Chart) Next objCht Next sht ' chart 시트에 별도로 만들어진 chart를 내보냄 For Each objCht In ActiveWorkbook.Charts Call ToPPT(objCht) Next objCht ' 위의 경우 제목과 붙여진 차트의 형식 갖추기 For j = 1 To pptSlide.Shapes.Count With pptSlide.Shapes(j) ' 그림이 붙여질 위치 If .Type = msoPicture Then ' 비례 유지를 취소 .LockAspectRatio = 0 .Top = 86 .Left = 34 .Height = 410 .Width = 650 End If ' 제목 박스의 내용과 글꼴 변경 If .Type = msoTextBox Then With .TextFrame.TextRange .Font.Color = vbBlue .Font.Name = "맑은 고딕" .Font.Size = 28 .Font.Bold = msoTrue .ParagraphFormat.Alignment = ppAlignCenter .Text = chtTitle End With End If End With Next j End Sub Private Sub ToPPT(xlCht As Chart) On Error Resume Next xlCht.ChartArea.Copy ' 필요에 따라 ppPasetJPG를 여러 포멧으로 변경하여 내보냄 pptSlide.Shapes.PasteSpecial ppPasteJPG End Sub Sub ChartsToPPT_By_9() ' 워크 시트에 존재하는 모든 chart를 새 파워포인트 슬라이드로 옮김 Dim sht As Worksheet Dim objCht As Object Dim j As Integer, Unit As Integer, i As Integer Dim row As Integer, col As Integer ' 1열로 배치할 chart의 수 Unit = 3 ' 속도를 위해 화면 갱신 중지 Application.ScreenUpdating = False ' 워크북에 존재하는 chart의 갯수를 셈. For Each sht In ActiveWorkbook.Worksheets cntCht = cntCht + sht.ChartObjects.Count Next sht ' chart가 없을 경우 에러 메시지 If cntCht + ActiveWorkbook.Charts.Count < 1 Then MsgBox " 내보내기 할 차트가 없습니다!", vbCritical, "경 고" Exit Sub End If ' 열려있는 파워포인트가 있는지 체크 On Error Resume Next Set pptApp = GetObject(, "PowerPoint.Application") On Error GoTo 0 ' 파워포인트 실행하고 프리젠테이션 생성 If pptApp Is Nothing Then Set pptApp = New PowerPoint.Application Set pptPres = pptApp.Presentations.Add ' 슬라이드 수를 세고 뒤에 하나 더 추가 pptSlideCount = pptPres.Slides.Count Set pptSlide = pptPres.Slides.Add(pptSlideCount + 1, ppLayoutBlank) ' 워크시트에 존재하는 모든 차트를 내보냄 For Each sht In ActiveWorkbook.Worksheets For Each objCht In sht.ChartObjects Call ToPPT(objCht.Chart) Next objCht Next sht ' chart 시트에 별도로 만들어진 chart를 내보냄 For Each objCht In ActiveWorkbook.Charts Call ToPPT(objCht) Next objCht ' 위의 경우 제목과 붙여진 차트의 형식 갖추기 For j = 1 To pptSlide.Shapes.Count If j > 9 Then pptSlide.MoveTo j \ 9 End If With pptSlide.Shapes(j) ' 그림이 정렬될 위치 결정 If .Type = msoPicture Then Select Case ((j - 1) \ Unit) Case 0 row = 150 col = (j Mod Unit) * 220 Case 1 row = 300 col = (j Mod Unit) * 220 Case 2 row = 450 col = (j Mod Unit) * 220 End Select End If ' 원본과 비례 유지 False .LockAspectRatio = 0 ' 그림 정렬될 위치 .Top = row - 100 .Left = col + 40 .Height = 140 .Width = 200 End With Next j ' 속도를 위해 중지되었던 갱신 진행 Application.ScreenUpdating = True ' 파워포인트 보이기 pptApp.Visible = True ' chart개수 초기화 cntCht = 0 ' objects 지우기 Set pptSlide = Nothing Set pptPres = Nothing Set pptApp = Nothing End Sub '엑셀 시트에 ActiveX 버튼하나 만드시고 아래 코드 연결시킵니다. '1은 슬라이드 한장에 시트하나, 9는 9장의 시트를 정렬시킵니다. Private Sub CommandButton1_Click() Dim kind As Integer kind = Application.InputBox("차트보내기 1: 1장씩, 9: 9장씩") If kind = 1 Then Call ChartsToPPT_By_1 ElseIf kind = 9 Then Call ChartsToPPT_By_9 End If End Sub |
첨부 화일 : 20160607-Chart-To-PPT_By_9Cht
|
1 |
End Sub |
꼭 해결 방법 올려주세요. 능력자님!!!
6월 13 2016
엑셀(EXCEL) – 일정행마다 제목행 추출과 일정행 아래의 특정 열들을 순차적으로 반복 이동
엑셀에서 VBA를 사용하는 경우 단순 반복 작업을 자동화하는 경우들에 유용한
방법입니다. 단순하게 반복하는 것과 논리적으로 반복하는 경우의 예를 아래에
들어보겠습니다. 처음에는 매크로 기록 기능으로 사용하다 조금 더 공부하시면
논리적으로 반복을 규칙화 시킬 수 있다고 봅니다.
http://www.clien.net/cs2/bbs/board.php?bo_table=kin&wr_id=3747083
엑셀 메크로 좀 도와주셔요ㅠㅠ
질문의 내용을 보시면 매크로 기록으로 한 번의 반복 작업을 기록하고 이것을
반복적으로 실행하는 법을 질문하셨는데 댓글에 DSFord님께서 반복매크로를
만들어 올려주셨는데 이것을 논리적 반복으로 바꾸어 보겠습니다.
아래의 두 매크로를 한 번 데이터를 500개 정도로 돌려봤는데 속도가 논리적 반복은
1초 정도인데 댓글의 방법으로 하니 150여초 정도 걸렸습니다. 숫자가 몇 천개되면
무시못할 정도의 시간과 쓸데없는? 작업을 하게됩니다.
위의 제목행의 논리를 찾아내는 방법이 어려웠어요. ㅠㅠ
첨부된 그림의 그래프롤 보시면 이해하실 수 있을 것입니다.
지우고 난 열값의 초기화에 따른 제목행을 선정하는 1차함수 유도
y=19*x +1 , 계산을 해 보면 알겠지만 k=0 부터 시작하므로 +1을 함
Cells(1, k + 4) = Cells(Unit * (k + 1) + 1, 1)
위의 코드를 잘 이해하셨으면 대부분의 반복 작업을 처리할 Module하나를
얻었고 이 코드를 응용해서 많은 부분을 자동화 할 수 있을 것으로 보입니다.
그냥 20개 행을 바로 바로 이동하는 코드는 쉬운데 제목행과 데이터행을
단위 갯수로 다르게 분리하는 부분이 상당히 어려운 부분이었습니다.
파일 첨부 : 20160610-리스트 형식을 특정 행으로 분리하여 열에 붙여넣기
By vinipapa • 무른모 • 0 • Tags: 엑셀(EXCEL), 특정열 분리 추출, 특정행