VBA调用AI大模型

经验创意 · 102 次浏览
Ulookperfect... 创建于 2025-02-07 18:00

创建一个按钮 按钮代码如下:
Private Sub CommandButton1_Click()
    ' 定义变量
    Dim question As String
    Dim response As String
    Dim url As String
    Dim apiKey As String
    Dim http As Object
    Dim content As String
    Dim startPos As Long
    Dim endPos As Long
    
    ' 获取 A1 单元格中的问题
    question = ThisWorkbook.Sheets(1).Range("A1").Value
    
    ' 设置 API 的 URL 和 API 密钥
    url = "****************" ' 替换为实际的 API URL
    apiKey = "***********" ' 替换为你的 API 密钥
    
    ' 创建 HTTP 请求对象
    Set http = CreateObject("MSXML2.XMLHTTP")
    
    ' 设置请求头
    http.Open "POST", url, False
    http.setRequestHeader "Content-Type", "application/json"
    http.setRequestHeader "Authorization", "Bearer " & apiKey
    
    ' 设置请求体
    Dim requestBody As String
    requestBody = "{""model"":""*******(你的调用的模型名称)"",""messages"":[{""role"":""user"",""content"":""" & question & """}]}"
    
    ' 发送请求
    http.send requestBody
    
    ' 获取响应
    If http.Status = 200 Then
        response = http.responseText
        
        ' 从 JSON 字符串中提取 content 字段
        startPos = InStr(response, """content"":""") + Len("""content"":""")
        endPos = InStr(startPos, response, """")
        content = Mid(response, startPos, endPos - startPos)
        
        ' 将结果写入 A2 单元格
        ThisWorkbook.Sheets(1).Range("A2").Value = content
    Else
        ' 如果请求失败,显示错误信息
        ThisWorkbook.Sheets(1).Range("A2").Value = "Error: " & http.Status & " - " & http.statusText
    End If
End Sub

点击按钮后 会发送A1单元格的内容给AI,AI的回复会放在A2单元格

 


回复内容
暂无回复
回复主贴