在 MS Word 中嵌入運行 ChatGPT

VBA 代碼

Sub chatGPT()

    Dim request As Object
    Dim text As String, response As String, API As String, api_key As String, DisplayText As String, error_result As String
    Dim startPos As Long, status_code As Long
    Dim prompt As String
    Dim selectedText As Range

    'API Info
    API = "https://api.openai.com/v1/chat/completions"
    
    'API Key
 api_key = "sk-xxxxxxxxxxxxxxxxxxxxxxx"

    If api_key = "" Then
        MsgBox "Error: API key is blank!"
        Exit Sub
    End If
    
    ' Prompt the user to select text in the document
    If Selection.Type <> wdSelectionIP Then
        prompt = Trim(Selection.text)
        Set selectedText = Selection.Range
    Else
        MsgBox "Please select some text before running this macro."
        Exit Sub
    End If
        
    'Cleaning
    text = Replace(prompt, Chr(34), Chr(39))
    text = Replace(text, vbLf, "")
    text = Replace(text, vbCr, "")
    text = Replace(text, vbCrLf, "")

    ' Remove selection
    Selection.Collapse

    'Create an HTTP request object
    Set request = CreateObject("MSXML2.XMLHTTP")
    With request
        .Open "POST", API, False
        .setRequestHeader "Content-Type", "application/json"
        .setRequestHeader "Authorization", "Bearer " & api_key
        .send "{""model"": ""gpt-3.5-turbo"",  ""messages"": [{""content"":""" & text & """,""role"":""user""}]," _
             & """temperature"": 1, ""top_p"": 0.7}"
      status_code = .Status
      response = .responseText
    End With

    'Extract content
    If status_code = 200 Then
      DisplayText = ExtractContent(response)
                
    'Insert response text into Word document
    selectedText.InsertAfter vbNewLine & DisplayText

        
    Else
        startPos = InStr(response, """message"": """) + Len("""message"": """)
        endPos = InStr(startPos, response, """")
        If startPos > Len("""message"": """) And endPos > startPos Then
            DisplayText = Mid(response, startPos, endPos - startPos)
        Else
            DisplayText = ""
        End If
        
        'Insert error message into Word document
        EDisplayText = "Error : " & DisplayText
        selectedText.InsertAfter vbNewLine & EDisplayText
        
    End If
    
    
    'Clean up the object
    Set request = Nothing

End Sub


Function ExtractContent(jsonString As String) As String
    Dim startPos As Long
    Dim endPos As Long
    Dim Content As String
    
    startPos = InStr(jsonString, """content"": """) + Len("""content"": """)
    endPos = InStr(startPos, jsonString, "},") - 2
    Content = Mid(jsonString, startPos, endPos - startPos)
    Content = Trim(Replace(Content, "\""", Chr(34)))
        
    Content = Replace(Content, vbCrLf, "")
    Content = Replace(Content, vbLf, "")
    Content = Replace(Content, vbCr, "")
    Content = Replace(Content, "\n", vbCrLf)
     
    If Right(Content, 1) = """" Then
      Content = Left(Content, Len(Content) - 1)
    End If
    
    ExtractContent = Content

End Function

如何使用VBA代碼

按Alt+F11打開 VBA 編輯器。
單擊 「插入」\「模組」 以創建新模塊。
在模組中，貼上以上VBA 代碼。
將 API 密鑰替換api_key為您的實際 API 密鑰。
如果您想使用ChatGPT-4，您可以在上面的 VBA 代碼中替換gpt-3.5-turbo為gpt-4z。
關閉 VBA 編輯器。

在「開發人員\巨集」中，設定巨集作用於「所有使用中範本和文件」

在「選項\信任中心」開啟「啟用所有巨集」。

使用時，在Word中選取要輸入ChatGPT的文字，按Alt+F8執行巨集，然後選擇ChatGPT並單擊「執行」按鈕。

加入Word功能區

右鍵菜單欄，進入「自訂功能區」

(1)在右側選「常用」，(2)再依次按下面「新增群組」、(3)「重新命名」，改名隨意，例如為「GPT」，(4)保持選中它的狀態。(5)左側選擇命令「巨集」，會見到「Project.Module1.chatGPT」，(6)按一下它，(7)再按中間的「新增」，把它加入右側的「GPT」群組中，(8)可按「重新命名」，改為「ChatGPT」，選個喜歡的圖標，(9)按「確定」完成。

此時就可以在「常用」功能能表見到「ChatGPT」的按鈕了。結果圖：

使用方法：選取要輸入ChatGPT的文字，按一下ChatGPT按鈕，回覆會出現在下一行。

如何微調 ChatGPT 輸出
在上面的VBA 代碼中，您將遇到一個temperature參數。它的範圍從 0 到 2。增加該值（例如 1.2）將產生更隨機的輸出，而減小該值（例如 0.2）將產生更集中的輸出。

排除錯誤的步驟

該錯誤The model: gpt-4 does not exist意味著您無權訪問 GPT-4 API。您必須加入​openai.com/waitlist/gp… Plus**（ChatGPT 的付費版本）並不保證自動訪問 GPT-4 API，無論您是否擁有它。

轉引自：https://zhuanlan.zhihu.com/p/639504392