goodenoughcui's blog-革命尚未成功，同志仍须努力

1 将中所有要分析的XPS图谱并拖进Avantage窗口。

2 选中C1s窗口，选择工具栏中的峰拟合，在弹出的窗口中选择自动添加峰。

3 选择fit peaks标签，点击拟合这个层，拟合后若是还有没有寻到的峰，点击Add fitted peak，选择添加单个峰直到添加完所有峰，选择fit peaks标签，点击拟合所有层，点击确定。回到主界面，点击峰拟合标签，FWHM拟合项目下的0.5：3.5，将所有3.5改为2.5。确定C1s的峰位后，和284.8eV做对比，单击图谱左上角空白处，选中所有图谱，点击电荷移位，C1s与284.8eV相比小的，正位移差值，否则负位移差值，注意选择允许小数位移。按以上方法确定其他峰。

4 点击主界面的报告-报告至MS Excel导出数据。

1、创建宏

一、前期准备

    获取API密钥

1. 访问 DeepSeek 官网：https://platform.deepseek.com
2. 注册/登录账号
3. 进入控制台：API Keys
4. 创建新的API密钥并保存

启用Word开发工具

    1. 文档 → 选项 → 自定义功能区
    2. 右侧勾选「开发工具」
    3. 确定

二、创建VBA代码

    打开VBA编辑器

1. 点击「开发工具」选项卡
2. 点击「Visual Basic」
或
按 Alt + F11

添加引用

1. 工具 → 引用
2. 勾选：
   ☑ Microsoft XML, v6.0
   ☑ Microsoft VBScript Regular Expressions 5.5
3. 确定

创建新模块

    1. 插入 → 模块
    2. 粘贴以下代码

三、完整代码

Option Explicit

' API配置（请替换为你的真实API密钥）
Private Const API_KEY As String = "your_api_key_here"
Private Const API_URL As String = "https://api.deepseek.com/v1/chat/completions"
Private Const MODEL_NAME As String = "deepseek-chat"

' 主函数：检查选中文本的病句和错别字
Sub CheckGrammarWithDeepSeek()
    On Error GoTo ErrorHandler

    ' 1. 检查是否选中文本
    If Selection.Type = wdSelectionIP Then
        MsgBox "请先选择要检查的文本段落！", vbExclamation, "提示"
        Exit Sub
    End If

    Dim selectedText As String
    selectedText = Selection.Text

    ' 2. 长度保护（DeepSeek上下文约8K token，中文约4000字）
    If Len(selectedText) > 5000 Then
        If MsgBox("选中文本较长（约" & Len(selectedText) & "字符），可能影响处理速度。" & vbCrLf & _
                  "建议分批量检查。是否继续？", vbYesNo + vbQuestion, "文本过长") = vbNo Then
            Exit Sub
        End If
    End If

    ' 3. 显示状态栏提示
    Dim oldStatusBar As Boolean
    oldStatusBar = Application.DisplayStatusBar
    Application.DisplayStatusBar = True
    StatusBar = "正在连接AI进行语法检查..."

    ' 4. 创建HTTP对象
    Dim http As Object
    Set http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    ' 设置超时（毫秒）：解析、连接、发送、接收
    http.setTimeouts 30000, 60000, 60000, 120000

    ' 5. 构建系统提示（内核：只报告明显必须改正的错误）
    Dim systemPrompt As String
    systemPrompt = "你是一个严格的中文校对专家。请只指出用户文本中**明显且必须改正**的错误，包括：" & vbCrLf & _
                   "1. 错别字（如同音字、形近字误用，例如：的/地/得混淆、'在'写成'再'等）" & vbCrLf & _
                   "2. 病句（语序错误、主谓搭配不当、成分缺失导致语句不通）" & vbCrLf & _
                   "3. 标点符号严重错误（如句号缺失导致句子粘连）" & vbCrLf & _
                   "4. 重复或遗漏关键词汇" & vbCrLf & vbCrLf & _
                   "忽略轻微的修辞、风格问题（如口语化表达、重复虚词等）。" & vbCrLf & _
                   "输出格式要求（严格遵守）：" & vbCrLf & _
                   "如果没有错误，只输出：未发现必须改正的错误。" & vbCrLf & _
                   "如果有错误，每一条错误按照以下格式列出：" & vbCrLf & _
                   "----------------------------------------" & vbCrLf & _
                   "原文：[有错误的原句或短语]" & vbCrLf & _
                   "类型：[错别字/病句/标点/重复遗漏]" & vbCrLf & _
                   "修改建议：[正确写法]" & vbCrLf & _
                   "说明：[简短的错误解释]" & vbCrLf & _
                   "----------------------------------------" & vbCrLf & _
                   "注意：不要输出任何额外说明、开场白或结束语，直接输出检查结果。"

    ' 6. 构建请求体（温度设为0.2，保证结果稳定）
    Dim requestBody As String
    requestBody = "{""model"":""" & MODEL_NAME & """," & _
                  """messages"":[" & _
                  "{""role"":""system"",""content"":""" & SafeJsonEncode(systemPrompt) & """}," & _
                  "{""role"":""user"",""content"":""" & SafeJsonEncode(selectedText) & """}" & _
                  "],""temperature"":0.2,""max_tokens"":1500}"

    StatusBar = "正在提交请求..."

    ' 7. 发送请求
    With http
        .Open "POST", API_URL, False
        .setRequestHeader "Content-Type", "application/json; charset=UTF-8"
        .setRequestHeader "Authorization", "Bearer " & API_KEY
        .send requestBody
    End With

    StatusBar = "正在解析结果..."

    ' 8. 处理响应
    If http.Status = 200 Then
        Dim responseText As String
        responseText = ParseResponseImproved(http.responseText)

        ' 在Word中插入结果（保留原文本格式）
        Selection.Collapse Direction:=wdCollapseEnd
        Selection.InsertAfter vbCrLf & vbCrLf & "【DeepSeek语法检查结果】" & vbCrLf
        Selection.InsertAfter String(50, "=") & vbCrLf
        Selection.InsertAfter responseText
        Selection.InsertAfter vbCrLf & String(50, "=") & vbCrLf

        MsgBox "检查完成！", vbInformation, "成功"
    Else
        Dim errorDetail As String
        errorDetail = ExtractApiError(http.responseText)
        MsgBox "API请求失败：" & http.Status & " " & http.statusText & vbCrLf & _
               "详细信息：" & errorDetail, vbCritical, "错误"
    End If

    ' 9. 恢复状态栏
    StatusBar = ""
    Application.DisplayStatusBar = oldStatusBar
    Exit Sub

ErrorHandler:
    StatusBar = ""
    Application.DisplayStatusBar = oldStatusBar
    MsgBox "运行时错误：" & Err.Description & vbCrLf & "错误编号：" & Err.Number, vbCritical, "异常"
End Sub

' 安全JSON编码（处理所有特殊字符）
Private Function SafeJsonEncode(ByVal InputText As String) As String
    Dim result As String
    Dim i As Long
    Dim ch As String

    result = ""
    For i = 1 To Len(InputText)
        ch = Mid(InputText, i, 1)
        Select Case ch
            Case "\": result = result & "\\"
            Case """": result = result & "\"""
            Case vbCr: result = result & "\r"
            Case vbLf: result = result & "\n"
            Case vbTab: result = result & "\t"
            Case vbBack: result = result & "\b"
            Case vbFormFeed: result = result & "\f"
            Case Else
                ' 中文等Unicode字符无需转义，直接保留
                result = result & ch
        End Select
    Next i
    SafeJsonEncode = result
End Function

' 改进的JSON解析（处理多行、转义字符）
Private Function ParseResponseImproved(ByVal jsonText As String) As String
    On Error GoTo ParseErr

    ' 使用正则提取 "content" 字段的内容（支持转义引号和换行）
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    ' 模式说明：匹配 "content": " ... " ，其中内容可以包含转义符 \"
    regex.Pattern = """content""\s*:\s*""((?:[^""\\]|\\.)*?)""(?=\s*[,}])"
    regex.Global = False
    regex.MultiLine = True
    regex.IgnoreCase = False

    If regex.Test(jsonText) Then
        Dim matches As Object
        Set matches = regex.Execute(jsonText)
        Dim content As String
        content = matches(0).SubMatches(0)
        ' 还原转义串行
        content = UnescapeJsonString(content)
        ParseResponseImproved = Trim(content)
    Else
        ' 备用解析：查找 finish_reason 判断是否成功
        If InStr(jsonText, "finish_reason") > 0 Then
            ParseResponseImproved = "API响应解析失败，但请求可能已处理。原始片段：" & vbCrLf & Left(jsonText, 300)
        Else
            ParseResponseImproved = "无法解析API响应，请检查API密钥或网络。"
        End If
    End If
    Exit Function

ParseErr:
    ParseResponseImproved = "解析响应时出错：" & Err.Description & vbCrLf & "前200字符：" & Left(jsonText, 200)
End Function

' 还原JSON转义字符串
Private Function UnescapeJsonString(ByVal str As String) As String
    Dim result As String
    Dim i As Long

    result = ""
    i = 1
    While i <= Len(str)
        If Mid(str, i, 1) = "\" And i < Len(str) Then
            Dim nextChar As String
            nextChar = Mid(str, i + 1, 1)
            Select Case nextChar
                Case "n": result = result & vbCrLf: i = i + 2
                Case "r": result = result & vbCr: i = i + 2
                Case "t": result = result & vbTab: i = i + 2
                Case """": result = result & """": i = i + 2
                Case "\": result = result & "\": i = i + 2
                Case "u": ' 简单处理Unicode转义（如 \u4e2d），直接忽略并跳过6个字符
                    result = result & "[Unicode]": i = i + 6
                Case Else: result = result & "\": i = i + 1
            End Select
        Else
            result = result & Mid(str, i, 1)
            i = i + 1
        End If
    Wend
    UnescapeJsonString = result
End Function

' 提取API返回的错误信息
Private Function ExtractApiError(ByVal jsonText As String) As String
    On Error Resume Next
    Dim regex As Object
    Set regex = CreateObject("VBScript.RegExp")
    regex.Pattern = """message""\s*:\s*""([^""]+)"""
    If regex.Test(jsonText) Then
        ExtractApiError = regex.Execute(jsonText)(0).SubMatches(0)
    Else
        ExtractApiError = "无详细错误信息"
    End If
End Function

' 可选辅助函数：检查整个文档
Sub CheckWholeDocument()
    Selection.WholeStory
    CheckGrammarWithDeepSeek
End Sub

' 可选辅助函数：检查当前段落
Sub CheckCurrentParagraph()
    Selection.Paragraphs(1).Range.Select
    CheckGrammarWithDeepSeek
End Sub

四、另存为（另存选项）启用宏的模板，扩展名为dotm，将此模板保存在word的templates位置。在word中，文档-选项-加载项-模板-添加，选择刚新建的模板。

五、在word中，自定义快速访问工具栏，选择宏，添加刚新建的宏到快捷访问栏。

六、用法。选中文本，电极自定义工具栏的宏命令用来检测选中文本或全文。

goodenoughcui's blog-革命尚未成功，同志仍须努力

Tuesday, October 13, 2026

表格文本跨页时有大片空白怎么处理？

Tuesday, September 1, 2026

tbquant V3如何实现日志中时间格式的正确输出

Friday, August 7, 2026

Avantage分析XPS结果步骤

Monday, June 8, 2026

word2010工具栏嵌入deepseek来检测书写语法

Monday, June 1, 2026

163 邮箱提示 Unsafe Login 的拦截问题-workbuddy中163邮箱IMAP登录

Monday, May 18, 2026

Firefox中禁用Alt键

Sunday, May 10, 2026

windows下用小狼毫输入法，任务栏会卡顿的佬看这里