将DeepSeek接入word和WPS过程和完整代码（含逐行代码解释）

摘要：Function ChatToDeepSeek(chatText As String) As String 'API接口地址 Dim api_url As String 'DeepSeek官方申请的API Key Dim api_key As String '

看到网上有很多人分享DeepSeek接入Word和WPS的视频，但是大部分都不提供代码或者要拉人进群后才给代码！

我感觉很多人是想通过DeepSeek来收割韭菜，所以设置各种门槛，实在太坑，所以在这里分享适用DeepSeek接入Word和WPS的vba完整代码，并提供代码详细注释，需要的请拿走不谢！

生成前：选中需要提交给DeepSeek的内容，点击"生成"

调用DeepSeek后经过解析的结果

Function ChatToDeepSeek(chatText As String) As String 'API接口地址 Dim api_url As String 'DeepSeek官方申请的API Key Dim api_key As String '发送给DeepSeek的内容，jason格式的文本 Dim SendContent As String 'Http请求对象 Dim HttpRequest As Object '请求返回的错误码，http请求正常响应时返回200 Dim status_code As Integer 'http请求返回内容 Dim response As String '设置DeepSeek-V3 API接口地址 api_url = "https://api.deepseek.com/chat/completions" '设置DeepSeek官方申请的API Key（在的epseek官方开放平台注册后创建，注意：只在首次创建时自动复制后续无法复制，所以创建时记得保存） api_key = "xxxxxx，请替换为你在DeepSeek官方申请的API Key" '使用jason格式封装请求内容，主要包括使用的模型（deepseek-chat）和发送的给DeepSeek的文本内容。通过指定 model='deepseek-chat' 即可调用 DeepSeek-V3。 SendContent = "{""model"": ""deepseek-chat"", ""messages"": [{""role"":""user"", ""content"":""" & chatText & """}], ""stream"": false}" '实例化http请求对象，并调用接口获取返回数据 Set HttpRequest = CreateObject("MSXML2.XMLHTTP") With HttpRequest .Open "POST", api_url, False .setRequestHeader "Content-Type", "application/json" .setRequestHeader "Authorization", "Bearer " & api_key .send (SendContent) status_code = .Status response = .responseText End With ' 弹出窗口显示 API 响应（调试用） ' MsgBox "API请求返回内容: " & response, vbInformation, "调式信息" ' 请求正常返回 If status_code = 200 Then ChatToDeepSeek = response ' API key 错误，认证失败解决方法：请检查您的 API key 是否正确，如没有 API key，请先创建 API key ElseIf status_code = 401 Then ChatToDeepSeek = "Error: API key 错误，认证失败" & " - 响应内容：" & response ' 账号余额不足，解决方法：请确认账户余额，并前往充值页面进行充值 ElseIf status_code = 402 Then ChatToDeepSeek = "Error: 账号余额不足" & " - 响应内容：" & response ' 服务器内部故障解决方法：请等待后重试 ElseIf status_code = 500 Then ChatToDeepSeek = "Error: 服务器内部故障，请稍后重试" & " - 响应内容：" & response '服务器繁忙解决方法：请等待后重试 ElseIf status_code = 503 Then ChatToDeepSeek = "Error: 服务器繁忙，请稍后重试" & " - 响应内容：" & response ' 其他未知错误 Else ChatToDeepSeek = "Error: " & status_code & " - " & response End If Set HttpRequest = Nothing End FunctionSub DeepSeekV3 ' 聊天内容，即文档中选中用于和deepseek聊天的内容 Dim chatText As String ' 对话返回的内容 Dim responseText As String '正则表达式对象 Dim regex As Object '正在表达式匹配结果 Dim matches As Object '通过正则表达式解析后得到的deepseek回复对话内容 Dim content As String '选中的内容 Dim SelectionText As Object ' 保存文档中选中提交对话文本内容，即提出的问题 Set SelectionText = Selection.Range.Duplicate ' 替换一些不必要的空格、符号等 chatText = Replace(Replace(Replace(Replace(Replace(Selection.Text, "\", "\\"), vbCrLf, ""), vbCr, ""), vbLf, ""), Chr(34), "\""") responseText = ChatToDeepSeek(chatText) ' 接口调用没有错误但没有内容返回或返回空行 If Trim(responseText) = "" Then MsgBox "接口没有返回数据或返回空行", vbCritical '调用API接口后DeepSeek正常返回聊天内容 ElseIf Left(responseText, 5) "Error" Then ' 创建正则表达式对象 Set regex = CreateObject("VBScript.RegExp") '解析对话返回内容 With regex .Global = True .MultiLine = True .IgnoreCase = False .Pattern = """content"":""(.*?)""" End With Set matches = regex.Execute(responseText) If matches.Count > 0 Then content = matches(0).SubMatches(0) content = Replace(Replace(content, """", Chr(34)), """", Chr(34)) content = Replace(Replace(content, "\n", Chr(13)), "**", "") ' 将输入光标移到选中文本的末尾 Selection.Collapse Direction:=wdCollapseEnd ' 在选中内容后面插入一个新段落 Selection.TypeParagraph ' 设置新段落的内容为解析对话返回的内容 Selection.TypeText Text:=content ' 插入一个换行符 Selection.InsertBreak Type:=wdLineBreak ' 重新选中提交的对话内容 SelectionText.Select Else MsgBox "返回内容解析失败，请检查正则表达式是否正确", vbExclamation End If Else ' 显示调用接口返回的异常信息 MsgBox response, vbCritical End If End Sub

（1）新建一个Word文档，点击文件 -> 选项 -> 自定义功能区，勾选“开发者工具”。