Sub GenerateSlidesWithAutoFontSize()
Dim ppt As PowerPoint.Application
Dim pres As PowerPoint.Presentation
Dim slideTemplate As PowerPoint.Slide
Dim newSlide As PowerPoint.Slide
Dim tblLeft As PowerPoint.Shape
Dim tblRight As PowerPoint.Shape
Dim xlApp As Object
Dim xlWorkbook As Object
Dim xlSheetModels As Object
Dim xlSheetFrameworks As Object
Dim i As Integer, j As Integer
Dim lastRowModels As Integer, lastRowFrameworks As Integer
Dim textRange As TextRange
' 엑셀 파일 열기
Set xlApp = CreateObject("Excel.Application")
Set xlWorkbook = xlApp.Workbooks.Open("C:\경로\Expanded_ML_Analysis.xlsx") ' 🔹 엑셀 파일 경로 수정 필수
Set xlSheetModels = xlWorkbook.Sheets("ML_Models")
Set xlSheetFrameworks = xlWorkbook.Sheets("Data_Frameworks")
' 데이터 개수 확인 (각 시트의 마지막 행 찾기)
lastRowModels = xlSheetModels.Cells(xlSheetModels.Rows.Count, 1).End(-4162).Row ' xlUp 대신 -4162 사용
lastRowFrameworks = xlSheetFrameworks.Cells(xlSheetFrameworks.Rows.Count, 1).End(-4162).Row
' PPT 파일 열기
Set ppt = Application
Set pres = ppt.ActivePresentation
' 템플릿 슬라이드 (예: 2번째 슬라이드 사용)
Set slideTemplate = pres.Slides(2)
' 데이터 개수만큼 슬라이드 생성
For i = 2 To lastRowModels
slideTemplate.Duplicate
Set newSlide = pres.Slides(pres.Slides.Count)
' 표 찾기
For Each tblLeft In newSlide.Shapes
If tblLeft.HasTable Then Exit For
Next tblLeft
For Each tblRight In newSlide.Shapes
If tblRight.HasTable And tblRight.Left > tblLeft.Left Then Exit For
Next tblRight
' 왼쪽 표 (머신러닝 모델) 업데이트
tblLeft.Table.Cell(2, 1).Shape.TextFrame.TextRange.Text = xlSheetModels.Cells(i, 1).Value ' 모델명
tblLeft.Table.Cell(2, 2).Shape.TextFrame.TextRange.Text = xlSheetModels.Cells(i, 2).Value ' 설명
tblLeft.Table.Cell(2, 3).Shape.TextFrame.TextRange.Text = xlSheetModels.Cells(i, 3).Value ' 세부 내용
' 오른쪽 표 (데이터 분석 프레임워크) 업데이트
If i <= lastRowFrameworks Then
tblRight.Table.Cell(2, 1).Shape.TextFrame.TextRange.Text = xlSheetFrameworks.Cells(i, 1).Value ' 프레임워크명
tblRight.Table.Cell(2, 2).Shape.TextFrame.TextRange.Text = xlSheetFrameworks.Cells(i, 2).Value ' 설명
tblRight.Table.Cell(2, 3).Shape.TextFrame.TextRange.Text = xlSheetFrameworks.Cells(i, 3).Value ' 응용 분야
Else
' 연관성이 없으면 빈칸 처리
tblRight.Table.Cell(2, 1).Shape.TextFrame.TextRange.Text = ""
tblRight.Table.Cell(2, 2).Shape.TextFrame.TextRange.Text = ""
tblRight.Table.Cell(2, 3).Shape.TextFrame.TextRange.Text = ""
End If
' 📌 폰트 크기 자동 조정 (표 내부의 텍스트 크기 줄이기)
For Each tblLeft In newSlide.Shapes
If tblLeft.HasTable Then
For j = 1 To 3 ' 표의 세 개 열만 조정
Set textRange = tblLeft.Table.Cell(2, j).Shape.TextFrame.TextRange
textRange.Font.Size = AutoAdjustFontSize(textRange)
Next j
End If
Next tblLeft
For Each tblRight In newSlide.Shapes
If tblRight.HasTable Then
For j = 1 To 3
Set textRange = tblRight.Table.Cell(2, j).Shape.TextFrame.TextRange
textRange.Font.Size = AutoAdjustFontSize(textRange)
Next j
End If
Next tblRight
Next i
' 엑셀 닫기
xlWorkbook.Close False
xlApp.Quit
Set xlApp = Nothing
MsgBox "슬라이드 생성 완료!", vbInformation
End Sub
' 📌 자동 폰트 크기 조정 함수
Function AutoAdjustFontSize(txtRange As TextRange) As Integer
Dim maxWidth As Double
Dim minFontSize As Integer
Dim fontSize As Integer
minFontSize = 10 ' 최소 폰트 크기 제한
fontSize = 24 ' 기본 폰트 크기
' 표 셀의 가로 크기 기준으로 폰트 크기 자동 조정
maxWidth = txtRange.Parent.Width
Do While txtRange.BoundWidth > maxWidth And fontSize > minFontSize
fontSize = fontSize - 1
txtRange.Font.Size = fontSize
Loop
AutoAdjustFontSize = fontSize
End Function