效果展示

代码实现

Function QhBaiDuYunAIReq(question, _
                    Optional Authorization = "Bearer ", _
                    Optional Qhurl = "https://qianfan.baidubce.com/v2/chat/completions")
    Dim XMLHTTP As Object
    Dim url As String
    url = Qhurl '这里替换为你实际的URL
    Dim postData As String
'    postData = "model=deepseek-r1&" & "messages=[]"  '这里设置POST请求的数据
    
    
    requestBody = "{""model"":""deepseek-r1"",""messages"":[{""role"":""user"",""content"":""" & question & """}]}"
    



    Set XMLHTTP = CreateObject("MSXML2.XMLHTTP.6.0")
    XMLHTTP.Open "POST", url, False
    XMLHTTP.setRequestHeader "Content-Type", "application/json"
    XMLHTTP.setRequestHeader "Authorization", Authorization
    XMLHTTP.send requestBody
    
'    Debug.Print XMLHTTP.responseText
    
    
'    MsgBox QhReqText02

    If XMLHTTP.Status = 200 Then
        QhReqText = XMLHTTP.responseText
        
        QhReqText01 = Split(QhReqText, """content"":""")(1)
        QhReqText02 = Split(QhReqText01, """},""finish_reason")(0)
        
        QhReqText02 = Replace(QhReqText02, "\u003cthink\u003e\n\n\u003c/think\u003e\n\n", vbCrLf)   '替换不必要的内容
        
        QhReqText02 = Replace(QhReqText02, "\n", vbCrLf)  ' 回车转义符转vba的
        
'        Debug.Print XMLHTTP.responseText
    Else
'        Debug.Print "请求失败，状态码: " & XMLHTTP.Status
        MsgBox "请求失败，状态码: " & XMLHTTP.Status & vbCrLf & "检查你是否更新你的ApiKey，阙辉！"
    End If
    Set XMLHTTP = Nothing
    
    QhBaiDuYunAIReq = QhReqText02
End Function

Sub QhBaiDuYunAI()

    Authorization0 = "**************"   ' 你的百度云ApiKey
    Authorization0 = "Bearer " & Authorization0
    question0 = Sheets("百度云AI_deepseek").Range("B2")
    Sheets("百度云AI_deepseek").Range("B7") = "思考中，请勿操作Excel，QH！"
    Sheets("百度云AI_deepseek").Range("B9") = QhBaiDuYunAIReq(question0, Authorization0)
    Sheets("百度云AI_deepseek").Range("B7") = ""
End Sub