mada 发表于 2024-6-2 23:17:46

Excle中调用AI的VBA代码

参考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接口。
Option Explicit

'=====================================================
Const API_KEY As String = "<API_KEY>"
Const API_ENDPOINT As String = "https://api.openai.com/v1/chat/completions"
Const MODEL As String = "chatgpt-3.5-turbo"
Const MAX_TOKENS As String = "512"
Const TEMPERATURE As String = "0.1"
'=====================================================

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

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

    ' 定义请求体
    Dim requestBody As String
    requestBody = "{" & _
      """model"": """ & MODEL & """," & _
      """messages"": [{""role"": ""user"", ""content"": """ & prompt & """}]," & _
      """max_tokens"": " & MAX_TOKENS & "," & _
      """temperature"": " & TEMPERATURE & _
      "}"

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

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

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

      Dim completion As String
      completion = ParseResponse(response)

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

Function ParseResponse(ByVal response As String) As String
    ' 从 JSON 响应中解析生成的文本
    On Error Resume Next
    Dim startIndex As Long
    startIndex = InStr(response, """content"":""") + 11
    Dim endIndex As Long
    endIndex = InStr(startIndex, response, """") - 1
    ParseResponse = Mid(response, startIndex, endIndex - startIndex)
    On Error GoTo 0
End Function


页: [1]
查看完整版本: Excle中调用AI的VBA代码