当前位置：首页 > news >正文

DeepSeek 接入 Excel 完整教程

news 来源：原创 2025/4/19 7:26:14

一、前期准备

1.1 获取 DeepSeek API 密钥

注册 DeepSeek 平台
- 访问 DeepSeek 官方网站（或指定的 API 服务平台，如硅基流动等）。
- 若尚未注册，按照平台指引创建新账号并完成登录。
创建 API 密钥
- 进入用户控制面板，找到“API Keys”或“API 管理”选项。
- 点击“创建 API Key”按钮，填写应用名称（如 “Excel 文本助手”）及所需权限。
- 系统将生成类似 sk-xxxxxxxxxxxxxxxxxxxx 的 API 密钥，请复制并妥善保存，后续在 VBA 代码中需要使用此密钥。

二、配置 Excel 环境

2.1 启用“开发工具”选项卡

打开 Excel 后，点击【文件】>【选项】。
在“Excel 选项”对话框中，选择【自定义功能区】。
在右侧列表中勾选【开发工具】复选框，然后点击【确定】。
– 此时 Excel 功能区上会显示“开发工具”选项卡。

2.2 启用宏

在【文件】>【选项】中选择【信任中心】，点击【信任中心设置】。
在“宏设置”中选择“启用所有宏”（出于安全考虑，请仅在可信环境下使用）。
同时建议勾选“信任对 VBA 工程对象模型的访问”。

三、编写 VBA 宏调用 DeepSeek API

3.1 打开 VBA 编辑器并插入模块

在“开发工具”选项卡中点击【Visual Basic】（或按快捷键 Alt+F11）。
在 VBA 编辑器中，右击当前工程（例如“VBAProject(您的工作簿名)”），选择【插入】>【模块】。
– 建议将新模块命名为 DeepSeekModule。

3.2 粘贴以下完整代码

下面的代码实现了以下功能：

公共 API 调用函数：封装 HTTP 请求，向 DeepSeek API 发送请求并返回 JSON 字符串。
封装不同模型调用：提供调用 “deepseek-chat” 与 “deepseek-reasoner” 两种模型的接口函数。
主宏：获取当前单元格内容，将文本传给 API，然后将返回的处理结果写入当前单元格右侧的相邻单元格。

Option Explicit

'===============================
'【公共 API 调用函数】
'===============================
' 此函数向 DeepSeek API 发送请求。
' 参数：
'   api_key   —— 您的 API 密钥
'   inputText —— 要处理的文本（可以来自 Excel 单元格）
'   modelName —— 模型名称，如 "deepseek-chat" 或 "deepseek-reasoner"
' 返回值：
'   JSON 格式的响应字符串，或错误信息
Private Function CallDeepSeekAPI_Common(api_key As String, inputText As String, modelName 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 请求地址
    API = "https://api.deepseek.com/chat/completions"

    ' 构建 JSON 请求体，包含模型名称、系统角色提示与用户输入
    SendTxt = "{""model"": """ & modelName & """, " & _
              """messages"": [{" & _
                   """role"":""system"", ""content"":""你是 Excel 文案助手""}," & _
                   " {""role"":""user"", ""content"":""" & inputText & """}" & _
              "], ""stream"": false}"

    ' 发送 HTTP POST 请求
    On Error GoTo ErrHandler
    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

    If status_code = 200 Then
        CallDeepSeekAPI_Common = response
    Else
        CallDeepSeekAPI_Common = "Error: " & status_code & " - " & response
    End If

ExitPoint:
    Set Http = Nothing
    Exit Function

ErrHandler:
    CallDeepSeekAPI_Common = "Error: " & Err.Number & " - " & Err.Description
    Resume ExitPoint
End Function

' 调用 deepseek-chat 模型
Function CallDeepSeekChatAPI(api_key As String, inputText As String) As String
    CallDeepSeekChatAPI = CallDeepSeekAPI_Common(api_key, inputText, "deepseek-chat")
End Function

' 调用 deepseek-reasoner 模型
Function CallDeepSeekReasonerAPI(api_key As String, inputText As String) As String
    CallDeepSeekReasonerAPI = CallDeepSeekAPI_Common(api_key, inputText, "deepseek-reasoner")
End Function

'==============================================
'【主宏：使用 deepseek-chat 处理 Excel 中的文本】
'==============================================
Sub DeepSeekChat_Excel()
    Dim api_key As String
    Dim inputText As String
    Dim response As String
    Dim regex As Object
    Dim matches As Object
    Dim srcCell As Range
    Dim destCell As Range
    
    ' ========================================
    '【设置 API 密钥】
    ' ========================================
    ' 请将下面的文字替换为您的真实 API Key
    api_key = "在此处替换为您的 API Key"
    
    ' 检查 API 密钥是否为空
    If api_key = "" Then
        MsgBox "Please enter the API key.", vbCritical
        Exit Sub
    End If
    
    ' ========================================
    '【获取当前活动单元格文本】
    ' ========================================
    Set srcCell = ActiveCell
    If srcCell.Value = "" Then
        MsgBox "当前单元格为空，请选择包含文本的单元格。", vbExclamation
        Exit Sub
    End If
    
    inputText = srcCell.Value
    ' 对特殊字符进行转义处理
    inputText = Replace(inputText, "\", "\\")
    inputText = Replace(inputText, vbCrLf, " ")
    inputText = Replace(inputText, vbCr, " ")
    inputText = Replace(inputText, vbLf, " ")
    inputText = Replace(inputText, Chr(34), "\""")
    inputText = Replace(inputText, Chr(39), "\'")

    ' ========================================
    '【调用 DeepSeek API】
    ' ========================================
    response = CallDeepSeekChatAPI(api_key, inputText)
    
    If Left(response, 5) = "Error" Then
        MsgBox response, vbCritical
        Exit Sub
    End If

    ' ========================================
    '【解析 JSON 返回数据】
    ' ========================================
    ' 使用正则表达式提取返回 JSON 中 "content" 字段的值
    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(response, "\n", vbCrLf)
        response = Replace(response, "*", "")
        response = Replace(response, "#", "")
        
        ' ========================================
        '【将处理结果写入 Excel】
        ' ========================================
        ' 将结果写入当前单元格右侧的单元格（Offset(0,1)）
        Set destCell = srcCell.Offset(0, 1)
        destCell.Value = response
    Else
        MsgBox "Failed to parse API response.", vbExclamation
    End If
End Sub

'==============================================
'【主宏：使用 deepseek-reasoner 处理 Excel 中的文本】
'==============================================
Sub DeepSeekReasoner_Excel()
    Dim api_key As String
    Dim inputText As String
    Dim response As String
    Dim regex As Object
    Dim matches As Object
    Dim srcCell As Range
    Dim destCell As Range
    
    ' 请将下面的文字替换为您的真实 API Key
    api_key = "在此处替换为您的 API Key"
    
    If api_key = "" Then
        MsgBox "Please enter the API key.", vbCritical
        Exit Sub
    End If
    
    ' 获取当前活动单元格
    Set srcCell = ActiveCell
    If srcCell.Value = "" Then
        MsgBox "当前单元格为空，请选择包含文本的单元格。", vbExclamation
        Exit Sub
    End If
    
    inputText = srcCell.Value
    inputText = Replace(inputText, "\", "\\")
    inputText = Replace(inputText, vbCrLf, " ")
    inputText = Replace(inputText, vbCr, " ")
    inputText = Replace(inputText, vbLf, " ")
    inputText = Replace(inputText, Chr(34), "\""")
    inputText = Replace(inputText, Chr(39), "\'")
    
    ' 调用 deepseek-reasoner 模型
    response = CallDeepSeekReasonerAPI(api_key, inputText)
    
    If Left(response, 5) = "Error" Then
        MsgBox response, vbCritical
        Exit Sub
    End If
    
    ' 使用正则表达式提取 JSON 中 "content" 字段
    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(response, "\n", vbCrLf)
        response = Replace(response, "*", "")
        response = Replace(response, "#", "")
        
        ' 将结果写入当前单元格右侧（或自行指定其他位置）
        Set destCell = srcCell.Offset(0, 1)
        destCell.Value = response
    Else
        MsgBox "Failed to parse API response.", vbExclamation
    End If
End Sub

3.3 保存 VBA 代码

在 VBA 编辑器中点击【文件】>【保存】，或者直接关闭 VBA 编辑器即可。

四、将宏添加到 Excel 功能区（自定义按钮）

为了方便以后使用，可以将编写好的宏添加到 Excel 工具栏中：

打开 Excel 选项
点击【文件】>【选项】，在“Excel 选项”中选择【自定义功能区】。
新增自定义选项卡或分组
- 在右侧列表中点击“新建选项卡”，将其重命名为 “DeepSeek 助手”；
- 在该选项卡下新增一个分组，如 “DeepSeek 工具”。
添加宏命令
- 在左侧“从下列位置选择命令”中，选择“宏”，找到 DeepSeekChat_Excel 和（或） DeepSeekReasoner_Excel；
- 将所需宏拖拽到新建的分组中，并可修改按钮名称和图标。
点击确定，完成自定义设置后，在功能区中即可看到新添加的按钮。