Word 里面嵌入DeepSeek_word嵌入deepseek-CSDN博客

本文链接：https://blog.csdn.net/qq_39128364/article/details/145632006

一、问题描述

如何在Word里面嵌入DeepSeek?

二、解决方法

1、新建文档，按 Alt+F11，进入VB界面。

2、选中文档，右键->插入->模块。

3、进入模块，粘入VBA代码。（代码见下文）

4、保存为带宏的word文档。

5、回到文档，打开文件->选项->信任中心->宏设置->启用所有宏。

不同版本word可能界面有所不同，但大同小异，启用宏即可。

6、（1）在左侧选择宏，显示已保存的程序模块；

（2）在右侧，主选项卡->开发工具->新建组deepseek；

（3）左侧选中模块1，右侧选中新建的组deepseek，点击中间的添加，确定。

7、回到word界面，开发工具的选项卡下多了一个DeepSeek模块

8、测试程序运行情况，看一下效果（响应时间稍微有点长）

三、代码

代码来源（如有侵权，请联系博主删除）：如何在wps中加载deepseek？（文章后附VBA代码）_wps接入deepseek的vba代码-CSDN博客

DeepSeek嵌入Word之VBA | 编程语言前沿技术分享

Word接入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-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 = "输入你的deepseek 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