excel接入任意AI大模型,工作效率起飞!实测Agnes AI永久免费!

'自定义函数Get_AICortex：第一参数，目标单元格对象；第二参数，问题描述！Function Get_AICortex(TargetCell As Range, Question As String) As Variant   '▲▲▲程序创建-乔恩红-Codiaq▼▼▼ AI+Office办公应用   '▲▲▲祝各位道友办公顺利▼▼▼deepseek深度应用   '配置自己API KEY ★★★★ 可以去各个大模型平台去申请自己的API    On Error GoTo ErrorHandler    Const API_KEY As String = "这里请输入你申请的API KEY"  ' 需替换有效密钥，官网申请    Const API_URL As String = "这里请输入模型地址"  '去官网查看    ' 构建安全请求    Dim safeInput As String    safeInput = BuildSafeInput(TargetCell.Text, Question)    ' 发送API请求    Dim response As String    response = PostRequest(API_KEY, API_URL, safeInput)    ' 解析响应内容    If Left(response, 5) = "Error" Then        Get_AICortex = response    Else        Get_AICortex = ParseContent(response)    End If    Exit FunctionErrorHandler:    Get_AICortex = "Runtime Error: " & Err.DescriptionEnd Function' 构建安全输入内容Private Function BuildSafeInput(Context As String, Question As String) As String    Dim sysMsg As String    If Len(Context) > 0 Then        sysMsg = "{""role"":""system"",""content"":""上下文：" & EscapeJSON(Context) & """},"    End If    '模型名称需要和官网名称保持完全一致    BuildSafeInput = "{""model"":""这里请输入模型ID,也就是模型名称"",""messages"":[" & _        sysMsg & "{""role"":""user"",""content"":""" & EscapeJSON(Question) & """}]}"End Function' 发送POST请求Private Function PostRequest(apiKey As String, url As String, payload As String) As String    Dim http As Object    Set http = CreateObject("MSXML2.XMLHTTP")    On Error Resume Next    With http        .Open "POST", url, False        .setRequestHeader "Content-Type", "application/json"        .setRequestHeader "Authorization", "Bearer " & apiKey        .send payload        If Err.Number <> 0 Then            PostRequest = "Error: HTTP Request Failed"            Exit Function        End If        ' 增加10秒超时控制        Dim startTime As Double        startTime = Timer        Do While .readyState < 4 And Timer - startTime < 10            DoEvents        Loop    End With    If http.Status = 200 Then        PostRequest = http.responseText    Else        PostRequest = "Error " & http.Status & ": " & http.statusText    End IfEnd Function' JSON特殊字符转义Private Function EscapeJSON(str As String) As String    str = Replace(str, "\", "\\")    str = Replace(str, """", "\""")    str = Replace(str, vbCr, "\r")    str = Replace(str, vbLf, "\n")    str = Replace(str, vbTab, "\t")    EscapeJSON = strEnd Function' 智能解析响应内容Private Function ParseContent(json As String) As String    Dim regex As Object, matches As Object    Set regex = CreateObject("VBScript.RegExp")    ' 增强版正则表达式    With regex        .Pattern = """content"":\s*""((?:\\""|[\s\S])*?)"""        .Global = False        .Multiline = True        .IgnoreCase = True    End With    Set matches = regex.Execute(json)    If matches.Count > 0 Then        Dim rawText As String        rawText = matches(0).SubMatches(0)        ' 反转义处理        rawText = Replace(rawText, "\""", """")        rawText = Replace(rawText, "\\", "\")        rawText = Replace(rawText, "\n", vbCrLf)        rawText = Replace(rawText, "\r", vbCr)        rawText = Replace(rawText, "\t", vbTab)        ParseContent = rawText    Else        ' 错误信息提取        Dim errMatch As Object        regex.Pattern = """message"":\s*""(.*?)"""        Set errMatch = regex.Execute(json)        If errMatch.Count > 0 Then            ParseContent = "API Error: " & errMatch(0).SubMatches(0)        Else            ParseContent = "Invalid Response"        End If    End IfEnd Function