' 방법 1: 매크로 방식 - 가장 권장되는 방법
Sub ChatGPTTableMacro()
' 사용자로부터 질문 입력 받기
Dim prompt As String
prompt = InputBox("ChatGPT에게 물어볼 질문을 입력하세요:", "ChatGPT 표 생성")
If prompt = "" Then Exit Sub ' 취소 버튼 누른 경우
' 현재 선택된 셀
Dim targetCell As Range
Set targetCell = Selection.Cells(1, 1)
' 상태 표시
Application.StatusBar = "ChatGPT에 요청 중..."
Application.Cursor = xlWait
' API 호출
Dim response As String
response = GetChatGPTResponse(prompt)
' 표 형식으로 응답 처리하여 Excel에 삽입
ProcessTableResponse response, targetCell
' 상태 복원
Application.StatusBar = False
Application.Cursor = xlDefault
MsgBox "테이블이 생성되었습니다.", vbInformation
End Sub
Function GetChatGPTResponse(prompt As String) As String
Dim objHTTP As Object
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0")
Dim URL As String, API_KEY As String
URL = "https://api.openai.com/v1/chat/completions"
API_KEY = "주의할점 : 여기서는 직접 발급받으신 api key를 넣어주세요"
' 에러 처리 추가
On Error Resume Next
objHTTP.Open "POST", URL, False
If Err.Number <> 0 Then
GetChatGPTResponse = "연결 오류: " & Err.Description
Err.Clear
Exit Function
End If
On Error GoTo 0
objHTTP.setRequestHeader "Content-Type", "application/json; charset=utf-8"
objHTTP.setRequestHeader "Authorization", "Bearer " & API_KEY
' 시스템 메시지로 표 형식 응답 요청
Dim tableRequest As String
tableRequest = prompt & " 응답은 Excel에 바로 붙여넣을 수 있도록 CSV 형식이나 탭 구분 형식으로 제공해주세요. 마크다운이나 다른 서식 없이 순수 데이터만 제공해주세요."
Dim json As String
json = "{""model"": ""gpt-3.5-turbo-0125"", ""messages"": [{""role"": ""system"", ""content"": ""당신은 Excel 셀에 직접 붙여넣을 수 있는 표 형식(CSV/TSV)으로 응답하는 도우미입니다. 헤더 행을 포함해주세요. 마크다운 기호나 설명 없이 순수 데이터만 표 형식으로 제공하세요.""}, {""role"": ""user"", ""content"": """ & tableRequest & """}]}"
' 타임아웃 설정 증가
objHTTP.setTimeouts 30000, 30000, 30000, 30000
On Error Resume Next
objHTTP.send json
If Err.Number <> 0 Then
GetChatGPTResponse = "API 요청 오류: " & Err.Description
Set objHTTP = Nothing
Exit Function
End If
On Error GoTo 0
If objHTTP.Status = 200 Then
Dim responseText As String
responseText = objHTTP.responseText
' JSON 응답에서 content 부분 추출
Dim contentStart As Long, contentEnd As Long
contentStart = InStr(responseText, """content"": """)
' content 필드가 없을 경우 처리
If contentStart = 0 Then
GetChatGPTResponse = "응답 형식 오류. 원본 응답: " & Left(responseText, 300)
Set objHTTP = Nothing
Exit Function
End If
contentStart = contentStart + 12 ' """content"": """ 다음 위치
contentEnd = contentStart
Dim i As Long
For i = contentStart To Len(responseText)
Dim char As String
char = Mid(responseText, i, 1)
If char = """" Then
If Mid(responseText, i - 1, 1) <> "\" Then
contentEnd = i - 1
Exit For
End If
End If
Next i
If contentEnd > contentStart Then
Dim content As String
content = Mid(responseText, contentStart, contentEnd - contentStart + 1)
' 이스케이프된 문자 처리
content = Replace(content, "\""", """")
content = Replace(content, "\\", "\")
content = Replace(content, "\n", vbNewLine)
GetChatGPTResponse = content
Else
GetChatGPTResponse = "내용 파싱 오류: " & Left(responseText, 100)
End If
Else
' 오류 응답에서 더 많은 정보 추출
Dim errorMsg As String
errorMsg = "HTTP Error: " & objHTTP.Status & " - " & objHTTP.statusText & vbNewLine
' 모델 오류인 경우 추가 정보 제공
If InStr(objHTTP.responseText, "model") > 0 And objHTTP.Status = 404 Then
errorMsg = errorMsg & vbNewLine & "모델을 찾을 수 없습니다. gpt-3.5-turbo로 시도합니다."
' gpt-3.5-turbo로 재시도
Set objHTTP = Nothing
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0")
objHTTP.Open "POST", URL, False
objHTTP.setRequestHeader "Content-Type", "application/json; charset=utf-8"
objHTTP.setRequestHeader "Authorization", "Bearer " & API_KEY
json = "{""model"": ""gpt-3.5-turbo"", ""messages"": [{""role"": ""system"", ""content"": ""당신은 Excel 셀에 직접 붙여넣을 수 있는 표 형식(CSV/TSV)으로 응답하는 도우미입니다. 헤더 행을 포함해주세요. 마크다운 기호나 설명 없이 순수 데이터만 표 형식으로 제공하세요.""}, {""role"": ""user"", ""content"": """ & tableRequest & """}]}"
objHTTP.send json
If objHTTP.Status = 200 Then
responseText = objHTTP.responseText
contentStart = InStr(responseText, """content"": """) + 12
contentEnd = contentStart
For i = contentStart To Len(responseText)
char = Mid(responseText, i, 1)
If char = """" Then
If Mid(responseText, i - 1, 1) <> "\" Then
contentEnd = i - 1
Exit For
End If
End If
Next i
If contentEnd > contentStart Then
content = Mid(responseText, contentStart, contentEnd - contentStart + 1)
content = Replace(content, "\""", """")
content = Replace(content, "\\", "\")
content = Replace(content, "\n", vbNewLine)
GetChatGPTResponse = content
Set objHTTP = Nothing
Exit Function
End If
End If
End If
' 원래 오류 메시지 반환
GetChatGPTResponse = errorMsg & vbNewLine & "응답 내용: " & objHTTP.responseText
End If
Set objHTTP = Nothing
End Function
Sub ProcessTableResponse(response As String, targetCell As Range)
Dim lines() As String
lines = Split(response, vbNewLine)
' 마크다운 테이블 또는 일반 텍스트 파싱
Dim dataLines As New Collection
Dim inTable As Boolean: inTable = False
Dim i As Long
' 응답에서 실제 테이블 데이터 추출
For i = 0 To UBound(lines)
Dim line As String
line = Trim(lines(i))
' 빈 줄 건너뛰기
If line = "" Then GoTo ContinueForLoop
' 마크다운 표 구분선 제거 (|---|---|)
If InStr(line, "|-") > 0 And InStr(line, "|") > 0 Then
GoTo ContinueForLoop
End If
' 마크다운 표시 제거
If Left(line, 1) = "|" Then
line = Mid(line, 2, Len(line) - 2) ' 첫번째와 마지막 | 제거
line = Replace(line, " | ", vbTab) ' 구분자를 탭으로 변환
End If
' 코드 블록 표시 제거
If Left(line, 3) = "```" Then
GoTo ContinueForLoop
End If
' 실제 데이터 행 추가
dataLines.Add line
ContinueForLoop:
Next i
' 데이터가 없으면 종료
If dataLines.Count = 0 Then
targetCell.Value = "테이블 데이터를 찾을 수 없습니다."
Exit Sub
End If
' 데이터 행 수와 열 수 계산
Dim maxCols As Long: maxCols = 0
Dim separators As Variant
separators = Array(vbTab, ",") ' 탭이나 쉼표로 구분된 데이터 지원
' 구분자 결정 (첫 번째 행 기준)
Dim separator As String
separator = vbTab ' 기본값: 탭
' 첫 번째 행에서 가장 많이 사용된 구분자 찾기
Dim firstLine As String
firstLine = dataLines(1)
If InStr(firstLine, ",") > 0 And InStr(firstLine, vbTab) = 0 Then
separator = ","
End If
' 최대 열 수 계산
For i = 1 To dataLines.Count
Dim cols As Long
cols = UBound(Split(dataLines(i), separator)) + 1
If cols > maxCols Then maxCols = cols
Next i
' 테이블 데이터를 Excel 셀에 채우기
Dim rowIndex As Long: rowIndex = 0
For i = 1 To dataLines.Count
Dim cellValues() As String
cellValues = Split(dataLines(i), separator)
Dim colIndex As Long
For colIndex = 0 To UBound(cellValues)
' 데이터 셀에 값 입력
targetCell.Offset(rowIndex, colIndex).Value = Trim(cellValues(colIndex))
Next colIndex
rowIndex = rowIndex + 1
Next i
' 테이블 서식 적용
With targetCell.Resize(rowIndex, maxCols)
' 헤더 행 서식
With .Rows(1)
.Font.Bold = True
.Interior.Color = RGB(240, 240, 240)
End With
' 테두리
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
' 자동 필터 적용
.AutoFilter
' 열 너비 자동 조정
.Columns.AutoFit
End With
End Sub
' 방법 2: 사용자정의 버튼 생성 (리본 메뉴 또는 빠른 실행 도구 모음에 추가 가능)
Sub AddChatGPTButton()
' VBA에서 버튼 추가
Dim myBar As CommandBar
Set myBar = Application.CommandBars("Worksheet Menu Bar")
' 기존 버튼 제거 (중복 방지)
On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls("ChatGPT 테이블").Delete
On Error GoTo 0
' 새 버튼 추가
Dim newButton As CommandBarButton
Set newButton = myBar.Controls.Add(Type:=msoControlButton, Temporary:=True)
With newButton
.Caption = "ChatGPT 테이블"
.OnAction = "ChatGPTTableMacro"
.Style = msoButtonCaption
End With
MsgBox "ChatGPT 테이블 버튼이 추가되었습니다.", vbInformation
End Sub
' GPT 모델 선택 함수 추가
Function SelectGPTModel() As String
Dim modelChoice As Integer
modelChoice = MsgBox("고성능 GPT-4 모델을 사용하시겠습니까?" & vbNewLine & _
"(예=GPT-4 사용, 아니오=GPT-3.5-turbo 사용)", _
vbYesNo + vbQuestion, "GPT 모델 선택")
If modelChoice = vbYes Then
SelectGPTModel = "gpt-4o-mini" ' 또는 고성능 모델 중 사용 가능한 다른 모델
Else
SelectGPTModel = "gpt-3.5-turbo-0125"
End If
End Function
' 모델 선택 기능이 포함된 향상된 매크로
Sub ChatGPTTableMacroWithModelSelection()
' 모델 선택
Dim selectedModel As String
selectedModel = SelectGPTModel()
' 사용자로부터 질문 입력 받기
Dim prompt As String
prompt = InputBox("ChatGPT에게 물어볼 질문을 입력하세요:", "ChatGPT 표 생성 (" & selectedModel & ")")
If prompt = "" Then Exit Sub ' 취소 버튼 누른 경우
' 현재 선택된 셀
Dim targetCell As Range
Set targetCell = Selection.Cells(1, 1)
' 상태 표시
Application.StatusBar = selectedModel & "에 요청 중..."
Application.Cursor = xlWait
' API 호출 (모델 선택 전달)
Dim response As String
response = GetGPTResponseWithModel(prompt, selectedModel)
' 표 형식으로 응답 처리하여 Excel에 삽입
ProcessTableResponse response, targetCell
' 상태 복원
Application.StatusBar = False
Application.Cursor = xlDefault
MsgBox "테이블이 생성되었습니다. (사용 모델: " & selectedModel & ")", vbInformation
End Sub
' 모델 선택이 가능한 함수
Function GetGPTResponseWithModel(prompt As String, model As String) As String
Dim objHTTP As Object
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0")
Dim URL As String, API_KEY As String
URL = "https://api.openai.com/v1/chat/completions"
API_KEY = "sk-proj-wP710cdmTi31fqUA9bEpT3BlbkFJrXE9efYJQVOKjh2w14ya"
' 에러 처리 추가
On Error Resume Next
objHTTP.Open "POST", URL, False
If Err.Number <> 0 Then
GetGPTResponseWithModel = "연결 오류: " & Err.Description
Err.Clear
Exit Function
End If
On Error GoTo 0
' 요청 헤더 설정
objHTTP.setRequestHeader "Content-Type", "application/json; charset=utf-8"
objHTTP.setRequestHeader "Authorization", "Bearer " & API_KEY
' 시스템 메시지로 표 형식 응답 요청
Dim tableRequest As String
tableRequest = prompt & " 응답은 Excel에 바로 붙여넣을 수 있도록 CSV 형식이나 탭 구분 형식으로 제공해주세요. 마크다운이나 다른 서식 없이 순수 데이터만 제공해주세요."
Dim json As String
json = "{""model"": """ & model & """, ""messages"": [{""role"": ""system"", ""content"": ""당신은 Excel 셀에 직접 붙여넣을 수 있는 표 형식(CSV/TSV)으로 응답하는 도우미입니다. 헤더 행을 포함해주세요. 마크다운 기호나 설명 없이 순수 데이터만 표 형식으로 제공하세요.""}, {""role"": ""user"", ""content"": """ & tableRequest & """}]}"
' 타임아웃 설정 증가
objHTTP.setTimeouts 30000, 30000, 30000, 30000
On Error Resume Next
objHTTP.send json
If Err.Number <> 0 Then
GetGPTResponseWithModel = "API 요청 오류: " & Err.Description
Set objHTTP = Nothing
Exit Function
End If
On Error GoTo 0
If objHTTP.Status = 200 Then
Dim responseText As String
responseText = objHTTP.responseText
' JSON 응답에서 content 부분 추출
Dim contentStart As Long, contentEnd As Long
contentStart = InStr(responseText, """content"": """)
' content 필드가 없을 경우 처리
If contentStart = 0 Then
GetGPTResponseWithModel = "응답 형식 오류. 원본 응답: " & Left(responseText, 300)
Set objHTTP = Nothing
Exit Function
End If
contentStart = contentStart + 12 ' """content"": """ 다음 위치
contentEnd = contentStart
Dim i As Long
For i = contentStart To Len(responseText)
Dim char As String
char = Mid(responseText, i, 1)
If char = """" Then
If Mid(responseText, i - 1, 1) <> "\" Then
contentEnd = i - 1
Exit For
End If
End If
Next i
If contentEnd > contentStart Then
Dim content As String
content = Mid(responseText, contentStart, contentEnd - contentStart + 1)
' 이스케이프된 문자 처리
content = Replace(content, "\""", """")
content = Replace(content, "\\", "\")
content = Replace(content, "\n", vbNewLine)
GetGPTResponseWithModel = content
Else
GetGPTResponseWithModel = "내용 파싱 오류: " & Left(responseText, 100)
End If
Else
' 오류 응답에서 더 많은 정보 추출
Dim errorMsg As String
errorMsg = "HTTP Error: " & objHTTP.Status & " - " & objHTTP.statusText & vbNewLine
' 모델 오류인 경우 fallback 정보 제공
If InStr(objHTTP.responseText, "model") > 0 And objHTTP.Status = 404 Then
errorMsg = errorMsg & vbNewLine & "선택한 모델(" & model & ")을 사용할 수 없습니다. gpt-3.5-turbo로 시도해보세요."
End If
GetGPTResponseWithModel = errorMsg & vbNewLine & "응답 내용: " & objHTTP.responseText
End If
Set objHTTP = Nothing
End Function
' 리본 메뉴에 향상된 버튼 추가
Sub AddEnhancedButtons()
' VBA에서 버튼 추가
Dim myBar As CommandBar
Set myBar = Application.CommandBars("Worksheet Menu Bar")
' 기존 버튼 제거 (중복 방지)
On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls("ChatGPT 테이블").Delete
Application.CommandBars("Worksheet Menu Bar").Controls("GPT 모델 선택").Delete
On Error GoTo 0
' 새 버튼 추가
Dim newButton As CommandBarButton
Set newButton = myBar.Controls.Add(Type:=msoControlButton, Temporary:=True)
With newButton
.Caption = "ChatGPT 테이블"
.OnAction = "ChatGPTTableMacro"
.Style = msoButtonCaption
End With
' 모델 선택 버튼 추가
Dim modelButton As CommandBarButton
Set modelButton = myBar.Controls.Add(Type:=msoControlButton, Temporary:=True)
With modelButton
.Caption = "GPT 모델 선택"
.OnAction = "ChatGPTTableMacroWithModelSelection"
.Style = msoButtonCaption
End With
MsgBox "ChatGPT 테이블과 GPT 모델 선택 버튼이 추가되었습니다.", vbInformation
End Sub
' 뉴스 클리핑 매크로 추가
Sub ChatGPTNewsClipping()
' 사용자로부터 주제 입력 받기
Dim prompt As String
prompt = InputBox("뉴스 클리핑할 주제를 입력하세요:", "AI 뉴스 클리핑")
If prompt = "" Then Exit Sub ' 취소 버튼 누른 경우
' 현재 선택된 셀
Dim targetCell As Range
Set targetCell = Selection.Cells(1, 1)
' 상태 표시
Application.StatusBar = "뉴스 클리핑 요청 중..."
Application.Cursor = xlWait
' API 호출 (뉴스 클리핑용 프롬프트)
Dim newsPrompt As String
newsPrompt = "다음 주제에 대한 최신 뉴스 요약을 제공해주세요: " & prompt & _
" 날짜, 제목, 내용 요약, 출처, URL을 포함한 표 형식으로 정리해 주세요."
Dim response As String
response = GetChatGPTResponse(newsPrompt)
' 표 형식으로 응답 처리하여 Excel에 삽입
ProcessNewsClippingResponse response, targetCell
' 상태 복원
Application.StatusBar = False
Application.Cursor = xlDefault
MsgBox "뉴스 클리핑이 완료되었습니다.", vbInformation
End Sub
Sub ProcessNewsClippingResponse(response As String, targetCell As Range)
' 기본 테이블 처리 함수와 유사하지만 URL 열에 하이퍼링크 추가
Dim lines() As String
lines = Split(response, vbNewLine)
' 마크다운 테이블 또는 일반 텍스트 파싱
Dim dataLines As New Collection
Dim i As Long
' 응답에서 실제 테이블 데이터 추출
For i = 0 To UBound(lines)
Dim line As String
line = Trim(lines(i))
' 빈 줄 건너뛰기
If line = "" Then GoTo ContinueForLoop
' 마크다운 표 구분선 제거 (|---|---|)
If InStr(line, "|-") > 0 And InStr(line, "|") > 0 Then
GoTo ContinueForLoop
End If
' 마크다운 표시 제거
If Left(line, 1) = "|" Then
line = Mid(line, 2, Len(line) - 2) ' 첫번째와 마지막 | 제거
line = Replace(line, " | ", vbTab) ' 구분자를 탭으로 변환
End If
' 코드 블록 표시 제거
If Left(line, 3) = "```" Then
GoTo ContinueForLoop
End If
' 실제 데이터 행 추가
dataLines.Add line
ContinueForLoop:
Next i
' 데이터가 없으면 종료
If dataLines.Count = 0 Then
targetCell.Value = "테이블 데이터를 찾을 수 없습니다."
Exit Sub
End If
' 데이터 행 수와 열 수 계산
Dim maxCols As Long: maxCols = 0
Dim separator As String
separator = vbTab ' 기본값: 탭
' 첫 번째 행에서 구분자 확인
Dim firstLine As String
firstLine = dataLines(1)
If InStr(firstLine, ",") > 0 And InStr(firstLine, vbTab) = 0 Then
separator = ","
End If
' 최대 열 수 계산
For i = 1 To dataLines.Count
Dim cols As Long
cols = UBound(Split(dataLines(i), separator)) + 1
If cols > maxCols Then maxCols = cols
Next i
' 테이블 데이터를 Excel 셀에 채우기
Dim rowIndex As Long: rowIndex = 0
For i = 1 To dataLines.Count
Dim cellValues() As String
cellValues = Split(dataLines(i), separator)
Dim colIndex As Long
For colIndex = 0 To UBound(cellValues)
' URL 칼럼 처리 - 마지막 칼럼으로 가정
If colIndex = UBound(cellValues) And InStr(cellValues(colIndex), "http") > 0 Then
' 하이퍼링크 설정
targetCell.Offset(rowIndex, colIndex).Value = cellValues(colIndex)
On Error Resume Next
targetCell.Offset(rowIndex, colIndex).Hyperlinks.Delete ' 기존 하이퍼링크 제거
targetCell.Worksheet.Hyperlinks.Add _
Anchor:=targetCell.Offset(rowIndex, colIndex), _
Address:=cellValues(colIndex), _
TextToDisplay:=cellValues(colIndex)
On Error GoTo 0
Else
' 일반 셀 처리
targetCell.Offset(rowIndex, colIndex).Value = Trim(cellValues(colIndex))
End If
Next colIndex
rowIndex = rowIndex + 1
Next i
' 테이블 서식 적용
With targetCell.Resize(rowIndex, maxCols)
' 헤더 행 서식
With .Rows(1)
.Font.Bold = True
.Interior.Color = RGB(240, 240, 240)
End With
' 테두리
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
' 자동 필터 적용
.AutoFilter
' 열 너비 자동 조정
.Columns.AutoFit
' URL 열은 더 넓게 (마지막 열로 가정)
If maxCols >= 5 Then
.Columns(maxCols).ColumnWidth = .Columns(maxCols).ColumnWidth * 1.5
End If
' 내용 열은 더 넓게 (3번째 열로 가정)
If maxCols >= 3 Then
.Columns(3).ColumnWidth = 60
End If
