做网站服务商产品推广图片
目录
一、效果展示
二、配置方法
三、使用方法
四、注意事项
1、永久化使用
2、宏被禁用
3、office的生成失败
记录自己学习应用DeepSeek的过程......
=======================================================================
这个是与WPS配套使用的过程，office的与这个类似：
一、效果展示
二、配置方法
1、在最上方的功能处找到开发工具，点击VB编辑器
2、点击“插入”——>"模块"，得到一个空白的编辑界面
将下面的代码复制进去，由于最近deepseek比较火，我自己私有化本地部署了deepseek r1，这里的url就是自己本地的地址，而且代码的处理也是针对于deepseek的输出进行的编写，如果是其他模型，应该会报错。需要注意修改的有：
第8行：API = "http://localhost:1234/v1/chat/completions/"，对应大模型的url地址
第9行： SendTxt = "{""model"": ""deepseek-r1-distill-qwen-7b"", ""messages"": [{""role"":""system"", ""content"":""你是一个文本编辑助手""}, {""role"":""user"", ""content"":""" & inputText & """}], ""stream"": false}"，对应大模型的调用请求参数，可能需要改的就是model这个参数
第42行：api_key = "1234"，对应于api_key，如果是本地私有化部署的就随意填写，如果是调用官网大模型的api，就为对应的key
Function CallDeepSeekAPI(api_key As String, inputText As String) As StringDim API As StringDim SendTxt As StringDim Http As ObjectDim status_code As IntegerDim response As StringAPI = "http://localhost:1234/v1/chat/completions/"SendTxt = "{""model"": ""deepseek-r1-distill-qwen-7b"", ""messages"": [{""role"":""system"", ""content"":""你是一个文本编辑助手""}, {""role"":""user"", ""content"":""" & inputText & """}], ""stream"": false}"Set Http = CreateObject("MSXML2.XMLHTTP")With Http.Open "POST", API, False.setRequestHeader "Content-Type", "application/json".setRequestHeader "Authorization", "Bearer " & api_key.send SendTxtstatus_code = .Statusresponse = .responseTextEnd With' 弹出窗口显示 API 响应（调试用）' MsgBox "API Response: " & response, vbInformation, "Debug Info"If status_code = 200 ThenCallDeepSeekAPI = responseElseCallDeepSeekAPI = "Error: " & status_code & " - " & responseEnd IfSet Http = Nothing
End FunctionSub DeepSeekR1()Dim api_key As StringDim inputText As StringDim response As StringDim regex As ObjectDim matches As ObjectDim originalSelection As Range' API Keyapi_key = "1234"If api_key = "" ThenMsgBox "Please enter the API key.", vbExclamationExit SubEnd If' 检查是否有选中文本If Selection.Type <> wdSelectionNormal ThenMsgBox "Please select text.", vbExclamationExit SubEnd If' 保存原始选区Set originalSelection = Selection.Range.Duplicate' 处理特殊字符inputText = Selection.TextinputText = Replace(inputText, "\", "\\")inputText = Replace(inputText, vbCrLf, " ")inputText = Replace(inputText, vbCr, " ")inputText = Replace(inputText, vbLf, " ")inputText = Replace(inputText, """", "\""") ' 转义双引号' 发送 API 请求response = CallDeepSeekAPI(api_key, inputText)' 处理 API 响应If Left(response, 5) <> "Error" Then' 解析 JSONSet regex = CreateObject("VBScript.RegExp")With regex.Global = True.MultiLine = True.IgnoreCase = False.Pattern = """content"":""(.*?)""" ' 匹配 JSON 的 "content" 字段End WithSet matches = regex.Execute(response)If matches.Count > 0 Then' 提取 API 响应的文本内容response = matches(0).SubMatches(0)' 处理转义字符response = Replace(response, "\n", vbCrLf)response = Replace(response, "\\", "\") ' 处理 JSON 里的反斜杠response = Replace(response, "&", "") ' 过滤 `&`，防止意外符号' 让光标移动到文档末尾，防止覆盖已有内容Selection.Collapse Direction:=wdCollapseEndSelection.TypeParagraphSelection.TypeText Text:=response' 将光标移回原来选中文本的末尾originalSelection.SelectElseMsgBox "Failed to parse API response.", vbExclamationEnd IfElseMsgBox response, vbCriticalEnd If
End Sub之后关闭窗口就行
3、点击wps左上角的”文件“——>”选项“，进入”选项“窗口，之后选择”自定义功能区“
进入后在开发工具这里新建组，我在这里改组名为deepseek，然后在左侧搜索”宏“，找到之前创建的模块，点击添加，并重新命名，我这里改为”生成“，最后点击确认即可。
三、使用方法
鼠标选择要发送给大模型的文案，点击你所重命名的功能按钮，我这里是”生成“
四、注意事项
1、永久化使用
这个宏只是一次性的，下次创建新的文档时，这个”生成“便不好使。
若要永久启动宏，需要将其保存成一个模板，每次创建文档时候，使用这个模板创建，具体方法为：
1）另存为带宏的模板
2）之后若要编辑新的word，点击“开发工具”——>"加载项"，去掉文档模板框中的内容，点选共用模板里面的deepseek_word.dotm，点击打开即可编辑。
2、宏被禁用
只需要把宏启动即可，wps和office的宏启动方式有所不同，不过均在“文件”——>"选项"——>"信任中心"这里，wps的直接可以看到“宏安全性”，将其调整问中或者低；而office的在“信任中心设置”里，在宏设置中启动所有宏即可。
3、office的生成失败
按照之前的步骤，一般不会出现问题，但是我在进行office的配置时发现报错。按照报错信息打印出来的结果，如下图所示，我个人推测是office在进行数据接收的时候有数据的长度限制，导致后面的数据直接截断，因此后面的数据处理时，格式错误使得内部报错。（不过网上也有说是因为单双引号导致的）
解决方案：
改成流式的输出，这样里面的vb代码需要变化
需要注意的是：
第九行：SendTxt = "{""model"": ""deepseek-r1-distill-qwen-7b"", ""messages"": [{""role"":""system"", ""content"":""我是一个文本生成助手""}, {""role"":""user"", ""content"":""" & inputText & """}], ""stream"": true}"，这里的stream改为true。
之后对strArr = Split(response, "data:") ，按照data对流数据进行切分，然后再正则匹配，取出答案进行拼接。
Function CallDeepSeekAPI(api_key As String, inputText As String) As StringDim API As StringDim SendTxt As StringDim Http As ObjectDim status_code As IntegerDim response As StringAPI = "http://localhost:1234/v1/chat/completions/"SendTxt = "{""model"": ""deepseek-r1-distill-qwen-7b"", ""messages"": [{""role"":""system"", ""content"":""我是一个文本生成助手""}, {""role"":""user"", ""content"":""" & inputText & """}], ""stream"": true}"Set Http = CreateObject("MSXML2.XMLHTTP")With Http.Open "POST", API, False.setRequestHeader "Content-Type", "application/json".setRequestHeader "Authorization", "Bearer " & api_key.send SendTxtstatus_code = .Statusresponse = .responseTextEnd With' 弹出窗口显示 API 响应（调试用）' MsgBox "API Response: " & response, vbInformation, "Debug Info"If status_code = 200 ThenCallDeepSeekAPI = responseElseCallDeepSeekAPI = "Error: " & status_code & " - " & responseEnd IfSet Http = Nothing
End FunctionSub DeepSeekR1()Dim api_key As StringDim inputText As StringDim response As StringDim lastRes As StringDim strArr() As StringDim regex As ObjectDim matches As ObjectDim originalSelection As RangelastRes = ""' API Keyapi_key = "1234"If api_key = "" ThenMsgBox "Please enter the API key.", vbExclamationExit SubEnd If' 检查是否有选中文本If Selection.Type <> wdSelectionNormal ThenMsgBox "Please select text.", vbExclamationExit SubEnd If' 保存原始选区Set originalSelection = Selection.Range.Duplicate' 处理特殊字符inputText = Selection.TextinputText = Replace(inputText, "\", "\\")inputText = Replace(inputText, vbCrLf, " ")inputText = Replace(inputText, vbCr, " ")inputText = Replace(inputText, vbLf, " ")inputText = Replace(inputText, """", "\""") ' 转义双引号' 发送 API 请求response = CallDeepSeekAPI(api_key, inputText)strArr = Split(response, "data:") ' 按照流数据进行切割Set regex = CreateObject("VBScript.RegExp")With regex.Global = True.MultiLine = True.IgnoreCase = False.Pattern = """content"":""(.*?)""" ' 匹配 JSON 的 "content" 字段End WithFor Each strItem In strArr ' 循环处理' 处理 API 响应If Left(strItem, 5) <> "Error" Then' 解析 JSONSet matches = regex.Execute(strItem)If matches.Count > 0 Then' 提取 API 响应的文本内容strItem = matches(0).SubMatches(0)' 处理转义字符strItem = Replace(strItem, vbCrLf, "")strItem = Replace(strItem, "\n", vbCrLf)strItem = Replace(strItem, "\\", "\") ' 处理 JSON 里的反斜杠strItem = Replace(strItem, "&", "") ' 过滤 `&`，防止意外符号If Len(strItem) <> 0 ThenlastRes = lastRes & strItemEnd IfEnd IfElseMsgBox response, vbCriticalEnd IfNext' 让光标移动到文档末尾，防止覆盖已有内容Selection.Collapse Direction:=wdCollapseEndSelection.TypeParagraphSelection.TypeText Text:=lastRes' 将光标移回原来选中文本的末尾originalSelection.Select
End Sub