手把手教你在word中接入deepseek，秒生文档材料v2

数据库平台优化 2025-02-26

252

注册deepseek获取API_KEY

1.登录https://www.volcengine.com/experience/ark?utm_term=202502dsinvite&ac=DSASUQY5&rc=QWZFYIW5，输入手机号注册，有邀请码送15元。

也可以手机扫码注册。

2.注册登录后，按照如下图指示进入

3.进入后点击控制台

4.左面菜单中找api key管理，然后创建apikey并复制，后面vba中使用

在word中添加deepseek的VBA脚本

1.在开发工具中天街vb脚本，如果没有开发工具，可在文件-选项-自定义功能区中设置

2.在Normal的模块下右键选择导入文件，选择下载的word调用deepseek.bas进行导入，bas下载方法，后台发送deepseekvba获得

或者添加模块直接复制下面代码，将前面保存的Key替换代码中第四行的"填写你的火山引擎的apikey"



Private Const API_URL As String = "https://ark.cn-beijing.volces.com/api/v3/chat/completions"
Private Const API_MODEL As String = "deepseek-v3-241226"
Private Const API_MODEL_R As String = "deepseek-r1-250120"
Private Const api_key As String = "填写你的火山引擎的apikey"


Function CallDeepSeekAPI(api_key As String, inputText As String)
    Dim API As String
    Dim SendTxt As String
    Dim Http As Object
    Dim status_code As Integer
    Dim response As String
    MsgBox "开始调用Deepseek V3进行总结，耐心等待......"


    API = API_URL
    SendTxt = "{""model"": """ & API_MODEL & """, ""messages"": [{""role"":""system"", ""content"":""你是word文案助手""}, {""role"":""user"", ""content"":""" & inputText & """}], ""stream"": false}"
     Set Http = CreateObject("WinHttp.WinHttpRequest.5.1")
    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




Function CallDeepSeekRAPI(api_key As String, inputText As String)
    Dim API As String
    Dim SendTxt As String
    Dim Http As Object
    Dim status_code As Integer
    Dim response As String
     MsgBox "开始调用Deepseek R1进行总结，耐心等待......"
    API = API_URL
    SendTxt = "{""model"": """ & API_MODEL_R & """, ""messages"": [{""role"":""system"", ""content"":""你是word文案助手""}, {""role"":""user"", ""content"":""" & inputText & """}], ""stream"": false}"
    Set Http = CreateObject("WinHttp.WinHttpRequest.5.1")
    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
    CallDeepSeekRAPI = response
    Else
      CallDeepSeekRAPI = "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 = "fbb50585-69fc-4bed-aabd-2415c539ecc7"
    If api_key = "" Then
       MsgBox "Please enter the API key."
      Exit Sub
    ElseIf Selection.Type <> wdSelectionNormal Then
       MsgBox "请选择文本."
     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))
        response = Replace(response, "\n\n", "\n")
        response = Replace(response, "\n", vbCrLf)
        response = Replace(response, "*", "")
        response = Replace(response, "#", "")
    ' 取消选中原始文本
       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




Sub DeepSeekR()


    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 = "fbb50585-69fc-4bed-aabd-2415c539ecc7"
    If api_key = "" Then
       MsgBox "Please enter the API key."
      Exit Sub
    ElseIf Selection.Type <> wdSelectionNormal Then
       MsgBox "请选择文本."
     Exit Sub
  End If
   ' 保存原始选中的文本
  Set originalSelection = Selection.Range.Duplicate
   inputText = Replace(Replace(Replace(Replace(Replace(Selection.text, "\", "\\"), vbCrLf, ""), vbCr, ""), vbLf, ""), Chr(34), "\""")
   response = CallDeepSeekRAPI(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))
        response = Replace(response, "\n\n", "\n")
        response = Replace(response, "\n", vbCrLf)
        response = Replace(response, "*", "")
        response = Replace(response, "#", "")
    ' 取消选中原始文本
       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