本文由 資源共享網 – ziyuan 發布，轉載請注明出處，如有問題請聯系我們！[免費]把DeepSeek集成到WPS
收藏獲取API key
deepseek-r1模型API Key獲取：https://www.deepseek.com/
開放平臺 https://platform.deepseek.com/
SiliconCloud提供的 deepseek-r1 API Key：https://cloud.siliconflow.cn/i/s9jq76d7sa
配置Wps
啟用開發工具
新建文檔，點擊 文件 -> 選項 -> 自定義功能區
勾選"工具"
2. 配置信任中心
點擊 信任中心 -> 宏安全性
安全性選擇"低"
3. 添加模塊
前置條件：安裝wps.vba，下載地址:https://pan.quark.cn/s/4e2b06b6295d
點擊工具 -> 開發工具，點擊VB 編輯器
在新窗口中點擊插入，選擇模塊
將下面的代碼復制到編輯區中（注意替換你自己的API key）
4. 自定義功能區
點擊 文件 -> 選項 -> 自定義功能區
選中，點擊新建組
右鍵新建組，點擊重命名
將其命名為"DeepSeek"
5. 添加命令
選擇DeepSeek（自定義）
在左側命令中選擇"宏"
找到并選中"DeepSeekV3"，點擊添加
點擊重命名
重命名為"生成"
點擊確定
使用方法
選中需要處理的文字
點擊"生成"按鈕
等待大模型響應
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 SubDeepSeek-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 SubDeepSeek-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 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
