获取APIkey
- deepseek-r1模型API Key获取（目前暂停开放）：https://www.deepseek.com/
- SiliconCloud提供的 deepseek-r1 API Key：https://cloud.siliconflow.cn/i/UY1hayHv
使用邀请码GMjvrcTD，注册能获得14元（相当于2000万Tokens）
配置WPS
启用开发工具
- 新建文档，点击 文件 -> 选项 -> 自定义功能区
- 勾选"工具"
配置信任中心
- 点击 信任中心 -> 宏安全性
- 安全性选择"低"
添加模块
- 前置条件：安装wps.vba，下载地址:https://pan.quark.cn/s/4e2b06b6295d
- 点击工具 -> 开发工具，点击VB 编辑器
- 在新窗口中点击插入，选择模块
- 将下面的代码复制到编辑区中**（注意替换你自己的API key）**
. 自定义功能区
- 点击 文件 -> 选项 -> 自定义功能区
- 选中，点击新建组
- 右键新建组，点击重命名
- 将其命名为"DeepSeek"
添加命令
- 选择DeepSeek（自定义）
- 在左侧命令中选择"宏"
- 找到并选中"DeepSeekV3"，点击添加
- 点击重命名
- 重命名为"生成"
- 点击确定
使用方法
- 选中需要处理的文字
- 点击"生成"按钮
- 等待大模型响应
创建模板
-
将你的文档另存为 Wps 模板 (.dotm)：
- 点击"文件" → “另存为”
- 选择保存类型为"Microsoft Word 带宏的模板文件 (*.dotm)"
- 保存到 Wps 的模板文件夹（通常是 C:\Users\用户名\AppData\Roaming\kingsoft\wps\startup，如C:\Users\Administrator\AppData\Roaming\kingsoft\wps\startup）
-
这样每次打开 Wps 时，宏就会自动可用
如果找不到AppData文件夹可以点击打开隐藏文件夹选项
配套代码
Deepseek-R1代码（官方apikey）
Function CallDeepSeekAPI(api_key As String, inputText As String) As String
Dim API As String
Dim SendTxt As String
Dim Http As Object
Dim status_code As Integer
Dim response As String
API = "https://api.deepseek.com/chat/completions"
SendTxt = "{""model"": ""deepseek-reasoner"", ""messages"": [{""role"":""system"", ""content"":""You are a Word assistant""}, {""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 SendTxt
status_code = .Status
response = .responseText
End With
' 弹出窗口显示 API 响应（调试用）
' MsgBox "API Response: " & response, vbInformation, "Debug Info"
If status_code = 200 Then
CallDeepSeekAPI = response
Else
CallDeepSeekAPI = "Error: " & status_code & " - " & response
End If
Set Http = Nothing
End Function
Sub DeepSeekR1()
Dim api_key As String
Dim inputText As String
Dim response As String
Dim regex As Object
Dim reasoningRegex As Object
Dim contentRegex As Object
Dim matches As Object
Dim reasoningMatches As Object
Dim originalSelection As Object
Dim reasoningContent As String
Dim finalContent As String
api_key = "替换为你的api key"
If api_key = "" Then
MsgBox "Please enter the API key."
Exit Sub
ElseIf Selection.Type <> wdSelectionNormal Then
MsgBox "Please select text."
Exit Sub
End If
' 保存原始选中的文本
Set originalSelection = Selection.Range.Duplicate
inputText = Replace(Replace(Replace(Replace(Replace(Selection.text, "\", "\\"), vbCrLf, ""), vbCr, ""), vbLf, ""), Chr(34), "\""")
response = CallDeepSeekAPI(api_key, inputText)
If Left(response, 5) <> "Error" Then
' 创建正则表达式对象来分别匹配推理内容和最终回答
Set reasoningRegex = CreateObject("VBScript.RegExp")
With reasoningRegex
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = """reasoning_content"":""(.*?)"""
End With
Set contentRegex = CreateObject("VBScript.RegExp")
With contentRegex
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = """content"":""(.*?)"""
End With
' 提取推理内容
Set reasoningMatches = reasoningRegex.Execute(response)
If reasoningMatches.Count > 0 Then
reasoningContent = reasoningMatches(0).SubMatches(0)
reasoningContent = Replace(reasoningContent, "\n\n", vbNewLine)
reasoningContent = Replace(reasoningContent, "\n", vbNewLine)
reasoningContent = Replace(Replace(reasoningContent, """", Chr(34)), """", Chr(34))
End If
' 提取最终回答
Set matches = contentRegex.Execute(response)
If matches.Count > 0 Then
finalContent = matches(0).SubMatches(0)
finalContent = Replace(finalContent, "\n\n", vbNewLine)
finalContent = Replace(finalContent, "\n", vbNewLine)
finalContent = Replace(Replace(finalContent, """", Chr(34)), """", Chr(34))
' 取消选中原始文本
Selection.Collapse Direction:=wdCollapseEnd
' 插入推理过程（如果存在）
If Len(reasoningContent) > 0 Then
Selection.TypeParagraph
Selection.TypeText "推理过程："
Selection.TypeParagraph
Selection.TypeText reasoningContent
Selection.TypeParagraph
Selection.TypeText "最终回答："
Selection.TypeParagraph
End If
' 插入最终回答
Selection.TypeText finalContent
' 将光标移回原来选中文本的末尾
originalSelection.Select
Else
MsgBox "Failed to parse API response.", vbExclamation
End If
Else
MsgBox response, vbCritical
End If
End Sub
DeepSeek-V3代码（官方apikey）
Function CallDeepSeekAPI(api_key As String, inputText As String) As String
Dim API As String
Dim SendTxt As String
Dim Http As Object
Dim status_code As Integer
Dim response As String
API = "https://api.deepseek.com/chat/completions"
SendTxt = "{""model"": ""deepseek-chat"", ""messages"": [{""role"":""system"", ""content"":""You are a Word assistant""}, {""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 SendTxt
status_code = .Status
response = .responseText
End With
' 弹出窗口显示 API 响应（调试用）
' MsgBox "API Response: " & response, vbInformation, "Debug Info"
If status_code = 200 Then
CallDeepSeekAPI = response
Else
CallDeepSeekAPI = "Error: " & status_code & " - " & response
End If
Set Http = Nothing
End Function
Sub DeepSeekV3()
Dim api_key As String
Dim inputText As String
Dim response As String
Dim regex As Object
Dim matches As Object
Dim originalSelection As Object
api_key = "替换为你的api key"
If api_key = "" Then
MsgBox "Please enter the API key."
Exit Sub
ElseIf Selection.Type <> wdSelectionNormal Then
MsgBox "Please select text."
Exit Sub
End If
' 保存原始选中的文本
Set originalSelection = Selection.Range.Duplicate
inputText = Replace(Replace(Replace(Replace(Replace(Selection.text, "\", "\\"), vbCrLf, ""), vbCr, ""), vbLf, ""), Chr(34), "\""")
response = CallDeepSeekAPI(api_key, inputText)
If Left(response, 5) <> "Error" Then
Set regex = CreateObject("VBScript.RegExp")
With regex
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = """content"":""(.*?)"""
End With
Set matches = regex.Execute(response)
If matches.Count > 0 Then
response = matches(0).SubMatches(0)
response = Replace(Replace(response, """", Chr(34)), """", Chr(34))
' 取消选中原始文本
Selection.Collapse Direction:=wdCollapseEnd
' 将内容插入到选中文字的下一行
Selection.TypeParagraph ' 插入新行
Selection.TypeText text:=response
' 将光标移回原来选中文本的末尾
originalSelection.Select
Else
MsgBox "Failed to parse API response.", vbExclamation
End If
Else
MsgBox response, vbCritical
End If
End Sub
DeepSeek-V3代码（硅基流动平台）
Function CallDeepSeekAPI(api_key As String, inputText As String) As String
Dim API As String
Dim SendTxt As String
Dim Http As Object
Dim status_code As Integer
Dim response As String
API = "https://api.siliconflow.cn/v1/chat/completions"
SendTxt = "{""model"": ""deepseek-ai/DeepSeek-V3"", ""messages"": [{""role"":""system"", ""content"":""You are a Word assistant""}, {""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 SendTxt
status_code = .Status
response = .responseText
End With
' 弹出窗口显示 API 响应（调试用）
' MsgBox "API Response: " & response, vbInformation, "Debug Info"
If status_code = 200 Then
CallDeepSeekAPI = response
Else
CallDeepSeekAPI = "Error: " & status_code & " - " & response
End If
Set Http = Nothing
End Function
Sub DeepSeekV3()
Dim api_key As String
Dim inputText As String
Dim response As String
Dim regex As Object
Dim matches As Object
Dim originalSelection As Object
api_key = "替换为你的api key"
If api_key = "" Then
MsgBox "Please enter the API key."
Exit Sub
ElseIf Selection.Type <> wdSelectionNormal Then
MsgBox "Please select text."
Exit Sub
End If
' 保存原始选中的文本
Set originalSelection = Selection.Range.Duplicate
inputText = Replace(Replace(Replace(Replace(Replace(Selection.text, "\", "\\"), vbCrLf, ""), vbCr, ""), vbLf, ""), Chr(34), "\""")
response = CallDeepSeekAPI(api_key, inputText)
If Left(response, 5) <> "Error" Then
Set regex = CreateObject("VBScript.RegExp")
With regex
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = """content"":""(.*?)"""
End With
Set matches = regex.Execute(response)
If matches.Count > 0 Then
response = matches(0).SubMatches(0)
response = Replace(Replace(response, """", Chr(34)), """", Chr(34))
' 取消选中原始文本
Selection.Collapse Direction:=wdCollapseEnd
' 将内容插入到选中文字的下一行
Selection.TypeParagraph ' 插入新行
Selection.TypeText text:=response
' 将光标移回原来选中文本的末尾
originalSelection.Select
Else
MsgBox "Failed to parse API response.", vbExclamation
End If
Else
MsgBox response, vbCritical
End If
End Sub
DeepSeek-R1代码（硅基流动平台）
Function CallDeepSeekAPI(api_key As String, inputText As String) As String
Dim API As String
Dim SendTxt As String
Dim Http As Object
Dim status_code As Integer
Dim response As String
API = "https://api.siliconflow.cn/v1/chat/completions"
SendTxt = "{""model"": ""deepseek-ai/DeepSeek-R1"", ""messages"": [{""role"":""system"", ""content"":""You are a Word assistant""}, {""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 SendTxt
status_code = .Status
response = .responseText
End With
' 弹出窗口显示 API 响应（调试用）
' MsgBox "API Response: " & response, vbInformation, "Debug Info"
If status_code = 200 Then
CallDeepSeekAPI = response
Else
CallDeepSeekAPI = "Error: " & status_code & " - " & response
End If
Set Http = Nothing
End Function
Sub DeepSeekR1()
Dim api_key As String
Dim inputText As String
Dim response As String
Dim regex As Object
Dim matches As Object
Dim originalSelection As Object
api_key = "替换为你的api key"
If api_key = "" Then
MsgBox "Please enter the API key."
Exit Sub
ElseIf Selection.Type <> wdSelectionNormal Then
MsgBox "Please select text."
Exit Sub
End If
' 保存原始选中的文本
Set originalSelection = Selection.Range.Duplicate
inputText = Replace(Replace(Replace(Replace(Replace(Selection.text, "\", "\\"), vbCrLf, ""), vbCr, ""), vbLf, ""), Chr(34), "\""")
response = CallDeepSeekAPI(api_key, inputText)
If Left(response, 5) <> "Error" Then
Set regex = CreateObject("VBScript.RegExp")
With regex
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = """content"":""(.*?)"""
End With
Set matches = regex.Execute(response)
If matches.Count > 0 Then
response = matches(0).SubMatches(0)
response = Replace(Replace(response, """", Chr(34)), """", Chr(34))
' 取消选中原始文本
Selection.Collapse Direction:=wdCollapseEnd
' 将内容插入到选中文字的下一行
Selection.TypeParagraph ' 插入新行
Selection.TypeText text:=response
' 将光标移回原来选中文本的末尾
originalSelection.Select
Else
MsgBox "Failed to parse API response.", vbExclamation
End If
Else
MsgBox response, vbCritical
End If
End Sub
pro/DeepSeek-R1代码（硅基流动）
Function CallDeepSeekAPI(api_key As String, inputText As String) As String
Dim API As String
Dim SendTxt As String
Dim Http As Object
Dim status_code As Integer
Dim response As String
API = "https://api.siliconflow.cn/v1/chat/completions"
SendTxt = "{""model"": ""Pro/deepseek-ai/DeepSeek-R1"", ""messages"": [{""role"":""system"", ""content"":""You are a Word assistant""}, {""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 SendTxt
status_code = .Status
response = .responseText
End With
' 弹出窗口显示 API 响应（调试用）
' MsgBox "API Response: " & response, vbInformation, "Debug Info"
If status_code = 200 Then
CallDeepSeekAPI = response
Else
CallDeepSeekAPI = "Error: " & status_code & " - " & response
End If
Set Http = Nothing
End Function
Sub DeepSeekR1()
Dim api_key As String
Dim inputText As String
Dim response As String
Dim regex As Object
Dim matches As Object
Dim originalSelection As Object
api_key = "替换为你的api key"
If api_key = "" Then
MsgBox "Please enter the API key."
Exit Sub
ElseIf Selection.Type <> wdSelectionNormal Then
MsgBox "Please select text."
Exit Sub
End If
' 保存原始选中的文本
Set originalSelection = Selection.Range.Duplicate
inputText = Replace(Replace(Replace(Replace(Replace(Selection.text, "\", "\\"), vbCrLf, ""), vbCr, ""), vbLf, ""), Chr(34), "\""")
response = CallDeepSeekAPI(api_key, inputText)
response = Replace(response, "\n", "")
If Left(response, 5) <> "Error" Then
Set regex = CreateObject("VBScript.RegExp")
With regex
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = """content"":""(.*?)"""
End With
Set matches = regex.Execute(response)
If matches.Count > 0 Then
response = matches(0).SubMatches(0)
response = Replace(Replace(response, """", Chr(34)), """", Chr(34))
' 取消选中原始文本
Selection.Collapse Direction:=wdCollapseEnd
' 将内容插入到选中文字的下一行
Selection.TypeParagraph ' 插入新行
Selection.TypeText text:=response
' 将光标移回原来选中文本的末尾
originalSelection.Select
Else
MsgBox "Failed to parse API response.", vbExclamation
End If
Else
MsgBox response, vbCritical
End If
End Sub
wps JS宏调用DeepSeek官方API
/*
功能:WPS宏调用DeepSeek-API
*/
function callDeepSeekAPI() {
// API配置
const apiUrl = "https://api.deepseek.com/chat/completions";
// sk-XX 替换为自己申请的API-KEY
const apiKey = "sk- ";
if(apiKey == "sk-XX"){
alert("请配置好API后使用");
return;
}
str_question = Selection.Text;
// 请求参数
const requestBody = JSON.stringify({
"model": "deepseek-chat",
"messages": [
{"role": "system", "content": "You are a helpful assistant."},
{"role": "user", "content": str_question}
],
"stream": false
});
// 创建HTTP请求
const xhr = new XMLHttpRequest();
xhr.open("POST", apiUrl, false); // 同步请求
xhr.setRequestHeader("Content-Type", "application/json");
xhr.setRequestHeader("Authorization", "Bearer " + apiKey);
xhr.send(requestBody);
// 处理响应
if (xhr.status === 200) {
const response = JSON.parse(xhr.responseText);
const reBoy = response.choices[0].message.content;
// 获取当前活动文档
doc = ActiveDocument
// 获取最后一个段落
lastParagraph = doc.Paragraphs.Last
// 在最后一个段落之后添加一个新段落
newParagraph = doc.Content.Paragraphs.Add(lastParagraph.Range)
// 在新段落中写入内容
newParagraph.Range.Text = '\n' + reBoy
} else {
alert("API调用失败！状态码：" + xhr.status +
"响应内容：" + xhr.responseText);
}
}
function Document_Open()
{
AddRightClickMenu()
}
function AddRightClickMenu() {
// 获取应用程序对象
var app = Application;
// 获取当前活动文档
var doc = app.ActiveDocument;
app.CommandBars("Text").Reset()
// 添加右键菜单项
app.CommandBars("Text").Controls.Add(
msoControlButton, // 控件类型：按钮
null, // 控件ID（可选）
null, // 参数（可选）
1, // 插入位置（可选）
true // 是否临时添加
).Caption = "调用DS-AI"; // 菜单项名称
// 为菜单项添加点击事件
app.CommandBars("Text").Controls("调用DS-AI").OnAction = "callDeepSeekAPI";
}
function wt_info(body){
// 获取当前活动文档
doc = ActiveDocument
// 获取最后一个段落
lastParagraph = doc.Paragraphs.Last
// 在最后一个段落之后添加一个新段落
newParagraph = doc.Content.Paragraphs.Add(lastParagraph.Range)
// 在新段落中写入内容
newParagraph.Range.Text = '\n' + body
}
补充：
如果上述在vb环境中开发遇到各种运行问题的可以按以下步骤修改配置：
打开wps->点击上方功能区开发工具->点击vb编辑器
打开vb编辑器后：
点击工具栏中的引用
勾选
扫一扫
538
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
