三分钟搞定DeepSeek接入Word，轻松打造专属你的写作神器

李先生的ChinaSDN

已于 2025-02-27 19:52:51 修改

阅读量5.1k

点赞数 22

文章标签： AI写作人工智能自然语言处理语言模型 AIGC word wps

于 2025-02-22 00:34:39 首次发布

本文链接：https://blog.csdn.net/JetLeeC111/article/details/145786483

版权

空出世的 DeepSeek，在自然语言处理方面表现出了卓越的能力，今天就来给大家详细介绍如何将 DeepSeek 接入 Word，让它成为文案创作的得力助手。

第一步：启用开发工具

打开Word文档，依次点击：【文件】>【更多...】>【选项】>【自定义功能区】，勾选【开发工具】。

第二步：启用宏命令

按如下操作启用宏命令：【文件】>【更多...】>【选项】>【信任中心】>【信任中心设置】>【宏设置】，点选【启用所有宏】。

第三步：创建VB宏命令

1. 点击菜单【开发工具】下的VB编辑器【Visual Basic】。

2. 进入后选择菜单【插入】>【模块】，命名为“DeepSeek”。

3. 复制下面的代码到DeepSeek模块中。

Function CallDeepSeekAPI(inputText As String) As String
  Dim strAPI As String
  Dim strAPIKey As String
  Dim strSendTxt As String
  Dim objHttp As Object
  Dim intStatusCode As Integer
  Dim strResponse As String
  
  ' API服务地址
  strAPI = "https://api.baystoneai.cn/v1/chat/completions"
  
  ' API密钥：替换为你申请的API Key
  strAPIKey = "YOUR_API_KEY"
  If strAPIKey = "" Then
    MsgBox "Please enter the API key."
    Exit Function
  ElseIf Selection.Type <> wdSelectionNormal Then
    MsgBox "Please select text."
    Exit Function
  End If
  
  ' API模型名称
  strSendTxt = "{""model"": ""deepseek-r1-distill-qwen-32b"", " & vbCrLf & _
             """messages"": [" & vbCrLf & _
             "   {""role"": ""system"", ""content"": ""You are a helpful assistant.""}, " & vbCrLf & _
             "   {""role"": ""user"", ""content"": """ & inputText & """}" & vbCrLf & _
             "], " & vbCrLf & _
             """max_tokens"": 8192, " & vbCrLf & _
             """stream"": false" & vbCrLf & _
             "}"
  
  Set objHttp = CreateObject("MSXML2.XMLHTTP")
  ' 调试用：弹出窗口显示发送报文
  ' MsgBox strSendTxt, vbInformation, "Debug Info"
  With objHttp
    .Open "POST", strAPI, False
    .setRequestHeader "Content-Type", "application/json"
    .setRequestHeader "Authorization", "Bearer " & strAPIKey
    .send strSendTxt
    intStatusCode = .Status
    strResponse = .responseText
  End With

  ' 调试用: 弹出窗口显示 API 的响应
  ' MsgBox "API Response: " & strResponse, vbInformation, "Debug Info"

  If intStatusCode = 200 Then
    CallDeepSeekAPI = strResponse
  Else
    CallDeepSeekAPI = "Error: " & intStatusCode & " - " & strResponse
  End If

  Set objHttp = Nothing
End Function


Sub DeepSeekR1()
  Dim strInputText As String
  Dim strResponse As String
  Dim objRegex As Object
  Dim objReasoningRegex As Object
  Dim objContentRegex As Object
  Dim objMatches As Object
  Dim objReasoningMatches As Object
  Dim objOriginalSelection As Object
  Dim strReasoningContent As String
  Dim strFinalContent As String

  ' 保存原始选中的文本
  Set objOriginalSelection = Selection.Range.Duplicate
  
  strInputText = Replace(Replace(Replace(Replace(Replace(Selection.Text, "\", "\\"), vbCrLf, ""), vbCr, ""), vbLf, ""), Chr(34), "\""")
  strResponse = CallDeepSeekAPI(strInputText)
  
  If Left(strResponse, 5) <> "Error" Then
    ' 创建正则表达式对象来分别匹配推理内容和最终回答
    Set objReasoningRegex = CreateObject("VBScript.RegExp")
    With objReasoningRegex
      .Global = True
      .MultiLine = True
      .IgnoreCase = False
      .Pattern = """reasoning_content"":""(.*?)"""
    End With
    
    Set objContentRegex = CreateObject("VBScript.RegExp")
    With objContentRegex
      .Global = True
      .MultiLine = True
      .IgnoreCase = False
      .Pattern = """content"":""(.*?)"""
    End With

    ' 提取推理内容
    Set objReasoningMatches = objReasoningRegex.Execute(strResponse)
    If objReasoningMatches.Count > 0 Then
      strReasoningContent = objReasoningMatches(0).SubMatches(0)
      strReasoningContent = Replace(strReasoningContent, "\n\n", vbNewLine)
      strReasoningContent = Replace(strReasoningContent, "\n", vbNewLine)
      strReasoningContent = Replace(Replace(strReasoningContent, """", Chr(34)), """", Chr(34))
    End If

    ' 提取最终回答
    Set objMatches = objContentRegex.Execute(strResponse)
    If objMatches.Count > 0 Then
      strFinalContent = objMatches(0).SubMatches(0)
      strFinalContent = Replace(strFinalContent, "\n\n", vbNewLine)
      strFinalContent = Replace(strFinalContent, "\n", vbNewLine)
      strFinalContent = Replace(Replace(strFinalContent, """", Chr(34)), """", Chr(34))

      ' 取消选中原始文本
      Selection.Collapse Direction:=wdCollapseEnd

      ' 插入推理过程（如果存在）
      If Len(strReasoningContent) > 0 Then
        Selection.TypeParagraph
        Selection.TypeText "推理过程："
        Selection.TypeParagraph
        Selection.TypeText strReasoningContent
        Selection.TypeParagraph
        Selection.TypeText "最终回答："
        Selection.TypeParagraph
      End If

      ' 插入最终回答
      Selection.TypeText strFinalContent

      ' 将光标移回原来选中文本的末尾
      objOriginalSelection.Select
    Else
      MsgBox "Failed to parse API response.", vbExclamation
    End If
  Else
    MsgBox strResponse, vbCritical
  End If
End Sub

代码说明：

以下3处需要关注。其中第2处，要注意替换修改YOUR_API_KEY为申请的API Key

# 第1处 API服务地址
  strAPI = "https://api.baystoneai.cn/v1/chat/completions"

# 第2处 API密钥：替换为你申请的API Key，下文有申请攻略
  strAPIKey = "YOUR_API_KEY"

# 第3处 API模型名称：其中"deepseek-r1-distill-qwen-32b"为模型名称，可替换为API服务支持的deepseek的不同版本
  strSendTxt = "{""model"": ""deepseek-r1-distill-qwen-32b"", " & vbCrLf & _

4. 其中的 API Key，申请地址：https://api.baystoneai.com/，教程可以查阅公众号文章“无需调试，2分钟快速接入 DeepSeek R1”。

5. 保存VB脚本并关闭窗口；再依次点击：【文件】>【更多...】>【选项】>【自定义功能区】，选择这里的“宏”，即可看到刚才创建的宏命令。

模版文件的"另存为"路径为：

C:\Users\你的电脑用户名\AppData\Roaming\Microsoft\Word\STARTUP

第四步：新建宏命令组

1. 在右侧继续右键【开发工具】，在它下面【添加新组】，并可重命名这个组。

添加的新组如下：

2. 将第三步创建的宏命令添加到这个组下面。在菜单【开发工具】中就可以看到这个按钮：

第五步：开始创作吧

在Word文档中测试一下这个功能，输入一段文字，点击新建的功能按钮。

# 输入文字
  请写一篇300字的有关AIGC发展前景的科技文章。

# 输出说明
  <think>...</think>为 deepseek-r1 模型输出的思维链内容。也可以通过改写VB宏命令脚本控制不输出，有兴趣的同学可以尝试优化。

之后，内容扩写、检查错别字、翻译、智能问答等等需求都可以直接在Word里完成。是不是很方便？

立即扫描下方二维码，快速接入 DeepSeek R1：

如果有模型服务方面的问题，可添加官方微信号，申请加入技术群，有技术专家在线解答：