word开发者模式下，直接选visual basic，把代码粘贴进去，CrateSelectedTextWithAI()函数下把apikey换成你自己的密钥，我这个密钥不可用。这里调用的是月之暗面的模型（有一定免费额度），其他模型的没试过，应该也能用。

apiKey = "换成你自己密钥"

然后关闭visual basic窗口，运行宏命令AddCustomMenuItem，这样就添加了右键菜单。在word中选择要替换的内容或者要生成的内容，然后右键，选择菜单，则根据菜单进行替换或者生成。提示词可根据自己的需要进行修改，没实现流式输出，好像vba下不行。只是简单的调用演示。

Sub AddCustomMenuItem()Dim cb As CommandBarDim cbBtn As CommandBarButton' 检查是否已经存在该菜单项，若存在则先删除On Error Resume NextApplication.CommandBars("Text").Controls("AI替换内容").DeleteApplication.CommandBars("Text").Controls("AI生成内容").DeleteOn Error GoTo 0' 在右键菜单中添加菜单项Set cb = Application.CommandBars("Text")Set cbBtn = cb.Controls.Add(Type:=msoControlButton)With cbBtn.Caption = "AI替换内容".OnAction = "ReplaceSelectedTextWithAI"End WithSet cb2 = Application.CommandBars("Text")Set cbBtn2 = cb.Controls.Add(Type:=msoControlButton)With cbBtn2.Caption = "AI生成内容".OnAction = "CrateSelectedTextWithAI"End With
End SubSub ReplaceContent()Dim originalText As StringDim newText As String' 获取选定文本originalText = Selection.Text' 弹出输入框让用户输入新的文本'newText = InputBox("请输入要替换的新内容：", "替换内容")' 替换选定文本的内容为新内容，并保留原始格式Selection.Text = newText
End Sub
Sub CrateSelectedTextWithAI()Dim xhr As ObjectDim apiKey As StringDim apiUrl As StringDim selectedText As StringDim response As StringDim message As String' 初始化API密钥和端点，换成你自己的密钥apiKey = "sk-ce20qi5Cetn7mV4RqyFruxMMrZHWGz7AHT2Hcfv0"apiUrl = "https://api.moonshot.cn/v1/chat/completions"' 创建XMLHttpRequest对象Set xhr = CreateObject("MSXML2.XMLHTTP")' 获取用户选择的文本If Selection.Type = 2 ThenselectedText = Selection.TextElseMsgBox "Please select some text first."Exit SubEnd If' 将 '\\r' 替换为换行符selectedText = Replace(selectedText, vbCr, "\n")' 构建JSON字符串Dim jsonText As StringjsonText = _"{" & vbCrLf & _"  ""model"": ""moonshot-v1-32k""," & vbCrLf & _"  ""messages"": [" & vbCrLf & _"    {""role"": ""system"", ""content"": ""你将收到一段或多段文字，将提供的文字内容替换，在保留原有含义的基础上，降低重复率，并进行内容扩充，内容扩充到原来的2倍""}," & vbCrLf & _"    {""role"": ""user"", ""content"": """ & selectedText & """}" & vbCrLf & _"  ]," & vbCrLf & _"  ""temperature"": 0.3" & vbCrLf & _"}"' 发送请求到Moonshot AI的APIxhr.Open "POST", apiUrl, Falsexhr.setRequestHeader "Authorization", "Bearer " & apiKeyxhr.setRequestHeader "Content-Type", "application/json"xhr.send jsonText' 获取响应response = xhr.responseText' 检查响应是否包含错误信息If InStr(response, """error""") > 0 Then' 解析错误信息Dim errorType As StringerrorType = Mid(response, InStr(response, """type"":""") + Len("""type"":"""), InStr(InStr(response, """type"":""") + Len("""type"":"""), response, """") - InStr(response, """type"":""") - Len("""type"":"""))' 根据错误类型显示相应的提示消息Select Case errorTypeCase "invalid_authentication_error"MsgBox "鉴权失败请确认，请确认API key 是否有效。"Case "invalid_request_error"MsgBox "输入格式有误，使用了预期外的参数。"Case "rate_limit_reached_error"MsgBox "You have exceeded the rate limit. Please try again later."Case "exceeded_current_quota_error"MsgBox "超过每分钟最大访问次数限制。"Case ElseMsgBox "费用不够了，请购买相关服务。"End SelectElse' 解析JSON响应message = Mid(response, InStr(response, """content"":""") + Len("""content"":"""), InStr(InStr(response, """content"":""") + Len("""content"":"""), response, """") - InStr(response, """content"":""") - Len("""content"":"""))' 提取新内容If message <> "" Then' 替换所选文本Selection.Text = Replace(message, "\n", vbCr)ElseMsgBox "No new content received from the API."End IfEnd If
End SubSub ReplaceSelectedTextWithAI()Dim xhr As ObjectDim apiKey As StringDim apiUrl As StringDim selectedText As StringDim response As StringDim message As String' 初始化API密钥和端点apiKey = "sk-ce20qi5Cetn7mV4RqyFruxMMrZHWGz7AHT2Hcfv0xFudCbDo"apiUrl = "https://api.moonshot.cn/v1/chat/completions"' 创建XMLHttpRequest对象Set xhr = CreateObject("MSXML2.XMLHTTP")' 获取用户选择的文本If Selection.Type = 2 ThenselectedText = Selection.TextElseMsgBox "Please select some text first."Exit SubEnd If' 将 '\\r' 替换为换行符selectedText = Replace(selectedText, vbCr, "\n")' 构建JSON字符串Dim jsonText As StringjsonText = _"{" & vbCrLf & _"  ""model"": ""moonshot-v1-32k""," & vbCrLf & _"  ""messages"": [" & vbCrLf & _"    {""role"": ""system"", ""content"": ""你将收到一段或多段文字，将其内容进行细化扩充，每段内容扩充作为至少600字""}," & vbCrLf & _"    {""role"": ""user"", ""content"": """ & selectedText & """}" & vbCrLf & _"  ]," & vbCrLf & _"  ""temperature"": 0.3" & vbCrLf & _"}"' 发送请求到Moonshot AI的APIxhr.Open "POST", apiUrl, Falsexhr.setRequestHeader "Authorization", "Bearer " & apiKeyxhr.setRequestHeader "Content-Type", "application/json"xhr.send jsonText' 获取响应response = xhr.responseText' 检查响应是否包含错误信息If InStr(response, """error""") > 0 Then' 解析错误信息Dim errorType As StringerrorType = Mid(response, InStr(response, """type"":""") + Len("""type"":"""), InStr(InStr(response, """type"":""") + Len("""type"":"""), response, """") - InStr(response, """type"":""") - Len("""type"":"""))' 根据错误类型显示相应的提示消息Select Case errorTypeCase "invalid_authentication_error"MsgBox "鉴权失败请确认，请确认API key 是否有效。"Case "invalid_request_error"MsgBox "输入格式有误，使用了预期外的参数。"Case "rate_limit_reached_error"MsgBox "You have exceeded the rate limit. Please try again later."Case "exceeded_current_quota_error"MsgBox "超过每分钟最大访问次数限制。"Case ElseMsgBox "费用不够了，请购买相关服务。"End SelectElse' 解析JSON响应message = Mid(response, InStr(response, """content"":""") + Len("""content"":"""), InStr(InStr(response, """content"":""") + Len("""content"":"""), response, """") - InStr(response, """content"":""") - Len("""content"":"""))' 提取新内容If message <> "" Then' 替换所选文本Selection.Text = Replace(message, "\n", vbCr)ElseMsgBox "No new content received from the API."End IfEnd If
End Sub
Function ParseJSONContent(ByVal strContent As String) As StringDim sc As ObjectDim jsonObj As ObjectDim content As StringDim message As String' 创建 ScriptControl 对象Set sc = CreateObject("ScriptControl")sc.Language = "JScript"' JSON 字符串content = strContent' 解析 JSON 字符串sc.ExecuteStatement "var obj = " & contentSet jsonObj = sc.Eval("obj")' 获取 content 字段的值message = sc.Eval("obj.choices[0].message.content")' 释放对象Set jsonObj = NothingSet sc = NothingParseJSONContent = messageEnd Function