将DeepSeek接入WPS，只要三步

只要三步，就可以将最近暴火的DeepSeek接入WPS。让你的办公效率拉满。

第一步：安装VBA插件

请直接在评论区直接回复：代码。我会将插件和代码的地址发送给您。下载后，解压，里面只有两个文件。一个是插件，请双击安装；另一个是代码的文本文件。

第二步：将代码写到WPS（不懂代码也没关系，按照下面操作来）

VBA插件安装好后，在WPS文字中新建一空白文件，然后：

1.在菜单栏中点击“工具”，再点击“开发工具”。

2.出现“开发工具”菜单，再点击“VB编辑器”

3.在弹出的“VB编辑器”中，在左边窗口的Normal模板上单击右键，选择插入--模块，将代码写入右边的窗口中。代码在文章末尾，或在评论中回复“代码”。特别要注意的是，在代码中需要将“sk-这里放在你自己的API key”替换您自己的APIKEY。这个APIKEY需要在DeepSeek官方申请。如果你使用非官方（比如硅基流动）的APIKEY，还要在代码中替换掉“
https://api.deepseek.com/v1/chat/completions”这个地址。

第三步：将代码指定到工具栏

1.在“文件”菜单点击“选项”，在弹出的窗口右边的“工具”新建组，并重命名为DeepSeek（也可以是你想要的任何名称），并在左边的常用命令中找到“宏”。如下图

2.为新建的"DeepSeek"指定宏功能。

3.点击确定回到主界面，在“工具”栏上已经多了一个按钮

若发现名称太长，也可回到上一步进行重命名

现在，将DeepSeek接入WPS的所有工作都已经完成。写一句话让他工作起来吧。

例如：写一段关于黄昏的文章，不超过200字。

下图的文字就是DeepSeek生成的。给点掌声

代码在这里：

' 添加缺失的单位转换函数（WPS可能缺少Word的CentimetersToPoints）
Function CentimetersToPoints(cm As Double) As Double
    CentimetersToPoints = cm * 28.3528 ' 1厘米 = 28.3528磅
End Function

Sub DeepSeekR1()
    Dim api_key As String
    Dim originalSelection As Range
    On Error GoTo ErrorHandler
    
    ' 常量定义（兼容WPS可能缺失的Word常量）
    Const WdSelectionNormal = 1
    
    api_key = "sk-这里放在你自己的API key"
    If api_key = "" Then
        MsgBox "请填写API密钥", vbExclamation
        Exit Sub
    End If
    
    If Selection.Type <> WdSelectionNormal Then
        MsgBox "请先选择文本", vbExclamation
        Exit Sub
    End If
    
    ' 保存原始选区并处理文本
    Set originalSelection = ActiveDocument.Range( _
        Selection.Start, _
        Selection.End)
    Dim inputText As String
    inputText = EscapeJsonString(Selection.Text)
    
    ' 调用API
    Dim response As String
    response = CallDeepSeekAPI(api_key, inputText)
    If Left(response, 5) = "Error" Then
        MsgBox response, vbCritical
        Exit Sub
    End If
    
    ' 处理响应
    Dim processedText As String
    processedText = CleanApiResponse(ExtractContent(response))
    If Len(processedText) = 0 Then
        MsgBox "未获取到有效响应", vbExclamation
        Exit Sub
    End If
    
    ' 插入格式化内容
    InsertFormattedText processedText, originalSelection
    
ErrorHandler:
    If Err.Number <> 0 Then
        MsgBox "运行时错误 " & Err.Number & ": " & Err.Description, vbCritical
    End If
End Sub

Function CallDeepSeekAPI(api_key As String, inputText As String) As String
    Dim http As Object, response As String
    Const API_URL = "https://api.deepseek.com/v1/chat/completions"
    On Error Resume Next
    
    ' 构造更安全的JSON请求体
    Dim jsonBody As String
    jsonBody = "{""model"":""deepseek-chat"",""messages"":[" & _
               "{""role"":""user"",""content"":""" & inputText & """}]," & _
               """temperature"":0.7,""max_tokens"":4096}"
    
    Set http = CreateObject("MSXML2.XMLHTTP")
    With http
        .Open "POST", API_URL, False
        .setRequestHeader "Content-Type", "application/json"
        .setRequestHeader "Authorization", "Bearer " & api_key
        .send jsonBody
        
        If .Status = 200 Then
            response = Replace(.responseText, Chr(0), "")
        Else
            response = "Error " & .Status & ": " & .statusText
        End If
    End With
    
    ' 记录日志（可选）
    ' LogToFile "API请求: " & jsonBody & vbCrLf & "响应: " & response
    
    CallDeepSeekAPI = response
    Set http = Nothing
End Function

Function EscapeJsonString(text As String) As String
    ' 全面处理JSON特殊字符转义
    Dim escapedText As String
    escapedText = Replace(text, "\", "\\")
    escapedText = Replace(escapedText, """", "\""")
    escapedText = Replace(escapedText, vbCrLf, "\n")
    escapedText = Replace(escapedText, vbCr, "\r")
    escapedText = Replace(escapedText, vbTab, "\t")
    EscapeJsonString = escapedText
End Function

Function ExtractContent(responseText As String) As String
    Dim regex As Object, matches As Object
    Set regex = CreateObject("VBScript.RegExp")
    
    With regex
        .Global = True
        .MultiLine = True
        .Pattern = """content"":\s*""((?:[^""\\]|\\.)*)"""
    End With
    
    Set matches = regex.Execute(responseText)
    If matches.Count > 0 Then
        ExtractContent = DecodeJsonString(matches(0).SubMatches(0))
    Else
        ExtractContent = ""
    End If
End Function

Function DecodeJsonString(jsonText As String) As String
    ' 处理JSON转义字符
    Dim decodedText As String
    decodedText = Replace(jsonText, "\""", """")
    decodedText = Replace(decodedText, "\\", "\")
    decodedText = Replace(decodedText, "\n", vbCrLf)
    decodedText = Replace(decodedText, "\r", vbCr)
    decodedText = Replace(decodedText, "\t", vbTab)
    DecodeJsonString = decodedText
End Function

Function CleanApiResponse(responseText As String) As String
    ' 清理多余空行和格式
    responseText = Replace(responseText, vbCrLf & vbCrLf, vbCrLf)
    responseText = Trim(responseText)
    CleanApiResponse = responseText
End Function

Sub InsertFormattedText(text As String, originalRange As Range)
    ' 智能插入带格式的文本
    originalRange.Collapse Direction:=wdCollapseEnd
    originalRange.InsertParagraphAfter
    originalRange.InsertAfter text
    
    ' 设置专业格式
    With originalRange.Paragraphs.Last.Range
        .Font.Name = "宋体"
        .Font.Size = 11
        .Paragraphs.FirstLineIndent = CentimetersToPoints(1) ' 首行缩进
        .Paragraphs.LineSpacing = 18 ' 1.5倍行距
    End With
End Sub

' 日志记录函数（可选）
Sub LogToFile(logText As String)
    Dim logFile As String
    logFile = Environ("USERPROFILE") & "\Desktop\api_log.txt"
    Open logFile For Append As #1
    Print #1, Now() & " | " & logText
    Close #1
End Sub