引言
自ChatGPT出现，各种基于它的软件扩展纷至沓来，目前Word支持ChatGPT的add-in有两款，可以通过:
插入->获取加载项->搜索openai查看。
其中Ghostwriter从介绍上看功能比较单一，而且软件需要购买，用自己的API-key，意味着调用API还要单独出钱。
第二个，软件似乎是免费的，应该也是用自己的API-key。从介绍的视频上看符合使用的预期，可以发送选取的文字到ChatGPT，并结合预设的prompt信息返回所需功能，但是安全性未知。
这类软件实际上是将内容发送到OpenAI的服务器，并将获取返回内容呈现，于是产生了使用VBA在Word中整合ChatGPT的想法。虽然使用其他语言(比如python)调用API更加方便快捷，但VBA对内容的操作更直接。
需求
使用ChatGPT修改语言时，需要将文本复制到网页版的chatGPT中。省掉复制粘贴的过程，能提升效率。设想有以下需求：
基本需求（已实现）
对选取的文字进行操作，包括修改语言，翻译，检查语法错误等
可以选择不同的模型
用自己的api-key
token数目显示和计费
进阶需求（已放弃）
提供add-in安装或者可分享
自定义Ribbon的图标
增加Ribbon下拉菜单，实现用户选择模型类型
增加Ribbon选项，实现用户提交api-key
作为野生程序猿，花了一下午完成基本需求，进阶的内容只要花时间是可以实现的。不过相信微软的攻城狮正在全力将ChatGPT的功能整合到Office全家桶中。类似这样个人级别的应用，最终会被微软发布的新功能淘汰，因此无意投入过多。此项目作为VBA练手，基本需求已满足，也可以作为微软发布新word前的过渡。
实现
一切的前提是有openAI的账号并且绑定了付款方式。新注册的账号有$18自动到账，因此无需绑定付款方式也可以调用。用完之后再决定需不需要单独为此付费。
1. API模型选择和费率
费用如下，是按照1k token来算的，可以简单理解为字数，但不完全相同。最新的模型是Davinci，收费也是最高的。注意这里的token数量指的是发送和返回的token的总和。ChatGPT告诉我6000字的文章，按照常规算法，会有10W的token。。好像还是网页版香呀。。
具体调用中，使用模型名称如下。
他们都是GPT3的模型，就自身使用感受来看，表现最好的还是davinci，它的速度也是最慢的，ada基本不能用，curie和babbage偶尔能用，不过有的时候连语法错误都修改不了，翻译也是各种不通顺。
2.代码
2.1.准备工作
采用添加宏的方式，首先要添加开发者选项卡。
这也不是必须的，因为可以通过快捷键Alt+F11直接打开VBA的界面。
如果只为当前的文本添加宏，就在当前的project下添加模块，如果是为所有的word文档添加宏的话，就在Normal中添加。之后插入模块，就可以添加VBA的代码了。
其次，为了保证之后的代码正常运行，需要添加程序需要用的几个Reference，它们的意思有点类似于R的library。不同的模块可以有不同的Reference，可以选择项目后统一添加。
再次，由于VB处理起API的信息就很麻烦，这里需要单独载入两个文件，主要是JsonConverter，它能将API返回的文本转化为Dictionary的形式方便提取。如果对正则表达熟悉的话，完全不需要使用JsonConverter就可获取到所需信息。
这里通过导入文件的形式，将下载到的bas文件导入。另外要注意的是需要使用这个版本的VBA-JSON-2.3.0，否则会报错。另外Dictionary定义了几个对象的属性，也需要导入。
2.2. 调用API
CallOpenAI，该函数会将word中选取的文字，加上你自己写的指示，一并提交给OpenAI的模型，函数返回值response是一个Dictionary，包括了model, choices, usage, created等各种字段。
model的选择和名称见上文。
prompt可以是任何指示，比如帮我修改这段文字。(变量名用instruction更合理)。
selectedText是Word文档中选取的文字。
Function CallOpenAI(model As String, prompt As String, selectedText As String) As Dictionary
Dim url As String
Dim headers As Object
Dim body As Object
Dim client As Object
Dim response As Object
' Set up the API endpoint URL, headers, and request body
url = "https://api.openai.com/v1/completions"
Set headers = CreateObject("Scripting.Dictionary")
headers.Add "Content-Type", "application/json"
headers.Add "Authorization", "Bearer <API_KEY>"
Set body = CreateObject("Scripting.Dictionary")
body.Add "model", model
body.Add "prompt", prompt & "{" & selectedText & "}"
body.Add "max_tokens", 1000
' Send the API request and get the response
Set client = CreateObject("MSXML2.XMLHTTP")
client.Open "POST", url, False
For Each key In headers.Keys
client.setRequestHeader key, headers(key)
Next
client.send JsonConverter.ConvertToJson(body)
'Debug.Print client.responseText
' Parse the response JSON and return the completed text
Set response = JsonConverter.ParseJson(client.responseText)
Set CallOpenAI = response
End Function这里需要在header变量中添加自己的OpenAI的API-Key，具体而言是在12行将<API_KEY> 替换为自己的API_key。
此外，body变量可以添加而外的模型参数比如n, temperature等控制结果的输出，具体见API文档。
2.3.提取信息
一众函数分别从response的以下字段提取相应信息。
"model"-模型名称
'usage"-模型使用情况，用了多少个token
”choices"-模型返回的文字信息，这就是ChatGPT的回答。
Function GetModel(response As Dictionary) As String
GetModel = response("model")
End Function
Function GetUsage(response As Dictionary) As Integer
GetUsage = response("usage")("total_tokens")
End Function
Function GetResponseText(response As Dictionary) As String
Dim resp As String
resp = response("choices")(1)("text")
resp = Trim(resp)
resp = Replace(resp, vbNewLine, "")
'resp = Replace(resp, "\n\n", "")
'resp = Replace(resp, vbLf, "")
'resp = Replace(resp, vbCrLf, "")
'resp = Replace(resp, Chr(10), "")
'resp = Replace(resp, Chr(13), "")
'resp = Replace(resp, vbCr, "")
'resp = Replace(resp, vbLf, "")
GetResponseText = resp
End FunctionDictornay的变量中，字典的字典是无法直接获取的，大部分操作都可能会报错，用Debug.Print也无法显示。比如choices下包括了一个字典，就需要使用类似的方式获取：response("choices")(1)("text")
2.4.计算模型使用费用
有必要根据模型的名称和使用量，计算一下使用成本。
Function GetEstimatedFee(model As String, totalTokens As Integer) As Double
' Set the token prices for each model
Dim tokenPrices As Object
Set tokenPrices = CreateObject("Scripting.Dictionary")
tokenPrices.Add "text-davinci-003", 0.02
tokenPrices.Add "text-curie-001", 0.002
tokenPrices.Add "text-babbage-001", 0.0005
' Calculate the estimated fee
Dim tokenPrice As Double
If tokenPrices.Exists(model) Then
tokenPrice = tokenPrices(model)
Else
'Defaultto the davinci token price if the modelisnot recognized
tokenPrice = tokenPrices("text-davinci-003")
End If
GetEstimatedFee = totalTokens * tokenPrice * 0.001
End Function2.5.返回信息到Word界面
该部分代码的输入为，提取到文本(也就是chatGPT给你的答案)，费用以及模式。
这里考虑了三种模式：
第一种，track, 是将文本使用修订的方式放到word中，事实证明并不好用，会将所选文字删除并加上提取的文本。并不是哪里不同修订哪里。
第二种, append, 是在所选文字后面加入提取的文本，并以蓝色标注。
第三种, replace, 是直接替换所选文本。
另外，使用量以及费用会以对话框的形式出现。
Sub ProcessChatGPTResponse(responseText As String, feeText As String, mode As String)
Dim newRange As Range
Dim resp As String
resp = responseText
'resp = responseText & "**" & feeText
' Get the current selection
Dim currentSelection As Range
Set currentSelection = Selection.Range
' Determine how to handle the corrected text based on the mode parameter
If mode = "track" Then
' Create a new range and insert the corrected text
Set newRange = ActiveDocument.Range(currentSelection.End, currentSelection.End)
newRange.Text = resp
' Track changes on the new range
ActiveDocument.TrackRevisions = True
currentSelection.Text = resp
ActiveDocument.TrackRevisions = False
ElseIf mode = "append" Then
Dim insertText As String
insertText = vbCr & resp
' Insert the corrected text in a new paragraph after the selection
currentSelection.InsertAfter insertText
'~~> Remove selection. This will move the cursor at end of selected word
Selection.MoveRight Unit:=wdCharacter, Count:=1
'~~> Select the inserted word
Selection.MoveRight Unit:=wdCharacter, Count:=Len(insertText), Extend:=wdExtend
Selection.Font.Color = wdColorBlue
ElseIf mode = "replace" Then
' Replace the selected text with the corrected text
currentSelection.Text = resp
End If
MsgBox "Estimated Cost:" & vbCrLf & feeText, vbInformation, "Estimated Cost"
End Sub3.界面
由于不同的按钮，目前只是用户的指示不同，剩下内容均一致，所以这里创建了一个函数，简化后面的流程。输入是model和prompt。这里统一使用了"append"的显示方式，即在选取文字之后添加chatGPT回答。
Sub RinbbonFun(model As String, prompt As String)
Dim selectedText As String
Dim response As Dictionary
Dim modelName As String
Dim tokenN As Integer
Dim feeText As String
Dim responseText As String
selectedText = Selection.Text
Set response = CallOpenAI(model, prompt, selectedText)
responseText = GetResponseText(response)
modelName = GetModel(response)
tokenN = GetUsage(response)
EstimatedFee = GetEstimatedFee(modelName, tokenN)
feeText = "Model: " & modelName & ", estimated cost: $" & EstimatedFee & "(Tokens:" & tokenN & ")"
'Debug.Print responseText
' Do something with the response, such as replace the selection with the returned text
ProcessChatGPTResponse responseText, feeText, "append"
End Sub建立相应的函数，用于不同的按钮。
Sub ImproveEmail()
RinbbonFun "text-davinci-003", "Improve my writing in the email:"
End Sub
Sub RewordIt()
RinbbonFun "text-davinci-003", "Rephrase the following texts and avoid Plagiarism:"
End Sub
Sub SummarizeIt()
RinbbonFun "text-davinci-003", "Summarize the following texts for me:"
End Sub
Sub Translate2CN()
RinbbonFun "text-davinci-003", "Translate the following texts into simplified Chinese:"
End Sub
Sub Translate2EN()
RinbbonFun "text-davinci-003", "Translate the following texts into English:"
End Sub
Sub ImproveWriting()
RinbbonFun "text-davinci-003", "Improve my writing:"
End Sub
Sub ElaborateIt()
RinbbonFun "text-davinci-003", "Elaborate the following content:"
End Sub然后在Ribbon选项中将这些宏添加成按钮。
修改名称和图标即可。
4.实际使用效果
找了一个改错题，选取整段文字，点击按钮，返回修改好的文字，以及使用信息。
之后用修改过的文字，测试其他按键。
至此，基本功能实现。其他的一些功能，比如使用下拉菜单选择想要的模型，添加输入框录入使用组的API-key，添加自定义的按钮图案等功能，需要通过XML定制Ribbon内容，就不浪费时间了。
2023/01/16
