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

从Word里面用VBA调用NVIDIA的免费DeepSeekR1

article 2025/2/12 20:36:40

看上去能用而已。

选中的文字作为输入，运行对应的宏即可；会先MSGBOX提示一下，然后相关内容追加到word文档中。
在这里插入图片描述需要自己注册生成好用的apikey

Option Explicit

Sub DeepSeek()
    Dim selectedText As String
    Dim apiKey As String
    Dim response As Object, re As String
    Dim midString As String
    Dim ans As String
    Dim URL
    If Selection.Type = wdSelectionNormal Then
        selectedText = Selection.Text
        selectedText = Replace(selectedText, ChrW$(13), "")
        apiKey = "nvapi--LlRnvapi-这里需要自己注册生成api key-LlR_nTfd" '"3f"
        URL = "https://integrate.api.nvidia.com/v1/chat/completions"
        Set response = CreateObject("MSXML2.XMLHTTP")
        response.Open "POST", URL, False
        response.setRequestHeader "Content-Type", "application/json"
        response.setRequestHeader "Authorization", "Bearer " + apiKey
        response.Send "{""model"":""deepseek-ai/deepseek-r1"", ""messages"":[{""role"":""user"",""content"":""" & selectedText & """}], ""temperature"":0.7}"
        
        re = response.responseText
        midString = Mid(re, InStr(re, """content"":""") + 11)
        MsgBox re
        ans = Split(midString, """")(0)
        ans = Replace(ans, "\n", "")
        Selection.Text = selectedText & vbNewLine & ans
        Else
        Exit Sub
    End If

End Sub

Sub DeepSeekPolish()
    Dim selectedText As String
    Dim apiKey As String
    Dim response As Object, re As String
    Dim midString As String
    Dim ans As String
    Dim polishPrompt As String
    Dim URL
    
    ' 检查是否有正常选中的文本
    If Selection.Type = wdSelectionNormal Then
        ' 获取选中文本并去除不需要的字符
        selectedText = Selection.Text
        selectedText = Replace(selectedText, ChrW$(13), "")
        
        ' 定义API密钥和请求URL
        apiKey = "nvapi-这里需要自己注册生成api key-LlR" ' 
        URL = "https://integrate.api.nvidia.com/v1/chat/completions"
        
        ' 设置润色提示词
        polishPrompt = "请润色以上文字，要求语句通顺，条理清晰，专业而合理。"
        
        ' 创建HTTP请求对象并设置参数
        Set response = CreateObject("MSXML2.XMLHTTP")
        response.Open "POST", URL, False
        
        ' 添加必要的头部信息
        response.setRequestHeader "Content-Type", "application/json"
        response.setRequestHeader "Authorization", "Bearer " + apiKey
        
        ' 发送请求，注意在JSON字符串中添加了polishPrompt
        response.Send "{""model"":""deepseek-ai/deepseek-r1"", ""messages"":[{""role"":""user"",""content"":""" & selectedText & """}, {""role"":""assistant"", ""content"":""" & polishPrompt & """}], ""temperature"":0.7}"
        
        ' 处理响应数据
        re = response.responseText
        MsgBox re
        
        midString = Mid(re, InStr(re, """content"":""") + 11)
        ans = Split(midString, """")(0)
        ans = Replace(ans, "\n", "")
        
        ' 将原选中文本与润色后的文本一起插入文档中
        Selection.Text = selectedText & vbNewLine & ans
    Else
        Exit Sub
    End If
End Sub