运行效果图

图片

调用DeepSeek后经过解析的结果

完整vba代码（复制代码粘贴即可）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 Subword配置过程（WPS类同）

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

图片

（2）点击 信任中心 -> 信任中心设置，选择“启用所有宏”与“信任对VBA......”。

图片

（3）接下来点击确定，我们发现选项卡中出现了“开发者工具”，点击开发者工具，点击Visual Basic，在新窗口中的插入，选择插入模块，把接入deepseek的VBA代码（参见我发布的文章）复制到编辑区中，替换官方申请的API key。完成后，可直接关闭窗口。

图片

（4）点击 文件 -> 选项 -> 自定义功能区，右键开发工具，点击添加新组命名为DeepSeek。选择DeepSeek（自定义），选择左侧的命令为“宏”，找到我们添加的DeepSeekV3，选中后点击添加并重命名为“生成”。

图片

完成后就在开发工具那里看到了DeepSeek的生成操作，现在就可以和DeepSeek聊天了。

（5）如果你想要所有文档都能够用到这个功能，那么请保存启用宏的word模板，保存路径:C:\Users\用户名\AppData\Roaming\Microsoft\Word\STARTUP

图片

本站仅提供存储服务，所有内容均由用户发布，如发现有害或侵权内容，请点击举报。