VBA脚本将DeepSeek嵌入Word中教程

一、获取API-Key

目前我们可以直接只用官网的API来实现，申请这一步是关键

也可以直接访问官网的API平台：https://platform.deepseek.com/ ，没注册的注册完登录一下，我们点击到左侧菜单的“APIKeys”按钮，然后点击右侧的“创建API Key”

在弹出的对话框中备注一下，以防忘记，点击创建，这样我们就获得了一个API Key了。记得先将密钥复制存放一下。一旦关闭就无法复制，只能删了重新创建。

二：WORD开启宏命令

要将DeepSeek集成到Word中必须先使用到“宏”，但是Office默认是禁用宏的，需先开启一下宏命令的功能。

启动Word应用程序。
在Word界面的顶部，找到并点击“文件”菜单。
在下拉菜单中，选择“选项”按钮以进入设置界面。
在弹出的“Word选项”窗口中，找到并点击左侧的“信任中心”设置。
在“信任中心”设置中，点击“信任中心设置...”按钮。
在“信任中心”对话框中，切换到“宏设置”选项卡。
在这里，您可以选择以下选项之一：
- “禁用所有宏，带通知”：所有宏都将被禁用，但会通知您宏的存在。
- “禁用所有宏，不通知”：所有宏都将被禁用，且不会通知您。
- “启用所有宏”：所有宏都将被允许运行，但请注意，这可能会带来安全风险。
- “禁用所有宏，除了签名的宏”：所有未签名的宏都将被禁用，但签名的宏将被允许运行。
根据您的需求选择合适的宏设置，然后点击“确定”保存设置。
再次点击“确定”关闭“信任中心”对话框，然后关闭“Word选项”窗口。

完成以上步骤后，您就可以在Word中使用宏功能了。如果您需要启用特定的宏，确保选择了允许宏运行的设置，并确保宏是来自可信的来源。启用宏后，您可以按照DeepSeek的集成指南，继续进行DeepSeek与Word的集成操作。

三、启动开发工具

一般Word因为禁用了“宏命令”，对应的“开发工具”菜单没开启，我们需要开启一下。按如下操作启动 “开发工具”菜单：“文件”——“选项”——“自定义功能”，勾选启动“开发工具”菜单

四、创建VB宏命令

点击“开发工具”下的Visual Basic编辑器

进入后点击菜单中的“插入”-“模块”，命名为“DeepSeek”

如下代码复制粘贴到模块中。

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"":""你是一个乐于助人的AI助手，请根据用户的问题给出详细的解答。""}, {""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