找回密码
 立即注册
搜索
热搜: 活动 交友 discuz
查看: 336|回复: 0

Excle中调用AI的VBA代码

[复制链接]

144

主题

73

回帖

923

积分

管理员

积分
923
发表于 2024-6-2 23:17:46 | 显示全部楼层 |阅读模式
参考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. Const API_KEY As String = "<API_KEY>"
  4. Const API_ENDPOINT As String = "https://api.openai.com/v1/chat/completions"
  5. Const MODEL As String = "chatgpt-3.5-turbo"
  6. Const MAX_TOKENS As String = "512"
  7. Const TEMPERATURE As String = "0.1"
  8. '=====================================================

  9. Function Chat(prompt As String) As String
  10.     ' 检查 API 密钥是否可用
  11.     If API_KEY = "<API_KEY>" Then
  12.         MsgBox "请在代码中输入有效的 API 密钥。", vbCritical, "未找到 API 密钥"
  13.         Exit Function
  14.     End If

  15.     ' 创建 XMLHTTP 对象
  16.     Dim httpRequest As Object
  17.     Set httpRequest = CreateObject("MSXML2.XMLHTTP")

  18.     ' 定义请求体
  19.     Dim requestBody As String
  20.     requestBody = "{" & _
  21.         """model"": """ & MODEL & """," & _
  22.         """messages"": [{""role"": ""user"", ""content"": """ & prompt & """}]," & _
  23.         """max_tokens"": " & MAX_TOKENS & "," & _
  24.         """temperature"": " & TEMPERATURE & _
  25.         "}"

  26.     ' 发送 HTTP 请求
  27.     With httpRequest
  28.         .Open "POST", API_ENDPOINT, True ' 使用异步请求
  29.         .SetRequestHeader "Content-Type", "application/json"
  30.         .SetRequestHeader "Authorization", "Bearer " & API_KEY
  31.         .send (requestBody)
  32.     End With

  33.     ' 等待请求完成
  34.     Do While httpRequest.readyState <> 4
  35.         DoEvents
  36.     Loop

  37.     ' 检查请求是否成功
  38.     If httpRequest.Status = 200 Then
  39.         Dim response As String
  40.         response = httpRequest.responseText

  41.         Dim completion As String
  42.         completion = ParseResponse(response)

  43.         ' 返回生成的文本完成结果
  44.         Chat = completion
  45.     Else
  46.         MsgBox "请求失败,状态码:" & httpRequest.Status & vbCrLf & vbCrLf & "错误消息:" & vbCrLf & httpRequest.responseText, vbCritical, "OpenAI 请求失败"
  47.         Chat = ""
  48.     End If
  49. End Function

  50. Function ParseResponse(ByVal response As String) As String
  51.     ' 从 JSON 响应中解析生成的文本
  52.     On Error Resume Next
  53.     Dim startIndex As Long
  54.     startIndex = InStr(response, """content"":""") + 11
  55.     Dim endIndex As Long
  56.     endIndex = InStr(startIndex, response, """") - 1
  57.     ParseResponse = Mid(response, startIndex, endIndex - startIndex)
  58.     On Error GoTo 0
  59. End Function
复制代码


您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

Archiver|手机版|小黑屋|Discuz! X

GMT+8, 2024-10-31 20:14 , Processed in 0.182194 second(s), 22 queries .

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表