Excle中调用AI的VBA代码

mada

参考Github项目
Integrate-ChatGPT-in-Excel-using-VBA/Demo_ChatGPT.xlsm at master · Sven-Bo/Integrate-ChatGPT-in-Excel-using-VBA (github.com)


代码在ChatGPT-4o模型帮助下完成

目的：
简化原项目代码，定义函数，将响应输出到Excel单元格。
实现异步请求，Excel等待 HTTP 请求响应时不会冻结窗口。
配合ONEAPI使用，可在国内网络环境调用Azure Openai等大模型API接口。

1. Option Explicit
   
2. 
   
3. '=====================================================
   
4. Const API_KEY As String = "<API_KEY>"
   
5. Const API_ENDPOINT As String = "https://api.openai.com/v1/chat/completions"
   
6. Const MODEL As String = "chatgpt-3.5-turbo"
   
7. Const MAX_TOKENS As String = "512"
   
8. Const TEMPERATURE As String = "0.1"
   
9. '=====================================================
   
10. 
    
11. Function Chat(prompt As String) As String
    
12.     ' 检查 API 密钥是否可用
    
13.     If API_KEY = "<API_KEY>" Then
    
14.         MsgBox "请在代码中输入有效的 API 密钥。", vbCritical, "未找到 API 密钥"
    
15.         Exit Function
    
16.     End If
    
17. 
    
18.     ' 创建 XMLHTTP 对象
    
19.     Dim httpRequest As Object
    
20.     Set httpRequest = CreateObject("MSXML2.XMLHTTP")
    
21. 
    
22.     ' 定义请求体
    
23.     Dim requestBody As String
    
24.     requestBody = "{" & _
    
25.         """model"": """ & MODEL & """," & _
    
26.         """messages"": [{""role"": ""user"", ""content"": """ & prompt & """}]," & _
    
27.         """max_tokens"": " & MAX_TOKENS & "," & _
    
28.         """temperature"": " & TEMPERATURE & _
    
29.         "}"
    
30. 
    
31.     ' 发送 HTTP 请求
    
32.     With httpRequest
    
33.         .Open "POST", API_ENDPOINT, True ' 使用异步请求
    
34.         .SetRequestHeader "Content-Type", "application/json"
    
35.         .SetRequestHeader "Authorization", "Bearer " & API_KEY
    
36.         .send (requestBody)
    
37.     End With
    
38. 
    
39.     ' 等待请求完成
    
40.     Do While httpRequest.readyState <> 4
    
41.         DoEvents
    
42.     Loop
    
43. 
    
44.     ' 检查请求是否成功
    
45.     If httpRequest.Status = 200 Then
    
46.         Dim response As String
    
47.         response = httpRequest.responseText
    
48. 
    
49.         Dim completion As String
    
50.         completion = ParseResponse(response)
    
51. 
    
52.         ' 返回生成的文本完成结果
    
53.         Chat = completion
    
54.     Else
    
55.         MsgBox "请求失败,状态码:" & httpRequest.Status & vbCrLf & vbCrLf & "错误消息:" & vbCrLf & httpRequest.responseText, vbCritical, "OpenAI 请求失败"
    
56.         Chat = ""
    
57.     End If
    
58. End Function
    
59. 
    
60. Function ParseResponse(ByVal response As String) As String
    
61.     ' 从 JSON 响应中解析生成的文本
    
62.     On Error Resume Next
    
63.     Dim startIndex As Long
    
64.     startIndex = InStr(response, """content"":""") + 11
    
65.     Dim endIndex As Long
    
66.     endIndex = InStr(startIndex, response, """") - 1
    
67.     ParseResponse = Mid(response, startIndex, endIndex - startIndex)
    
68.     On Error GoTo 0
    
69. End Function
    

复制代码