For those who can't afford a copilot membership or a WPS AI membership and still want to experience continuing text in a document, you can do so with macro code.
Two versions are available below for MacOS and Windows:
1. Please modify the API key and replace it with a free model
2. The basic usage is to first select the text and then press theAlt + F8Call up the macro operation, select ChatGPTReady to go.
core code
Sub chatGPTWord()
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 = "https://open.bigmodel.cn/api/paas/v4/chat/completions"
'Enter Your API Key
api_key = "Please get your own API KEY at open.bigmodel.cn"
'Model Name
modelName = "glm-4-plus"
systemPrompt = "You are a helpful chat bot that has expertise in WORD. Do not write explanations on replies. output should be markdown format without Output should be markdown format without markdown."
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.
Set selectedText = Selection.Range
MsgBox "Please select the content first!"
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"":""" & modelName & """, ""messages"": [{""content"":"" & systemPrompt & """,""role"":""system""},{" & _
"""content"":""" & text & ""","" & role"":"""user""}],"""temperature"": 1}""
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 & ConvertMarkdownToWord(DisplayText)
StartPos = InStr(response, "")
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
'{"choices":[{"finish_reason": "stop", "index":0, "message":{"content":"<html>\n<head>\n<title>Chat Bot Introduction</title>\n</head>\n<body>\n<h1>Hello!</h1>\n<p>I am a helpful chat bot with expertise in HTML.</p>\n</body>\n</html>", "role": "assistant"}}],""
startPos = InStr(1, jsonString, """content"":""") + Len("""content"": """)
endPos = InStr(startPos, jsonString, ","""role"":""") - 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
Function ConvertMarkdownToWord(markdownText As String)
Dim lines() As String
Dim i As Long
Dim lines As String
Dim headerLevel As Integer
Dim currentParagraph As Range
Dim table As table
Dim cellContent() As String
Dim cellContent() As String
Dim numColumns As Long
' Split Markdown text by lines
lines = Split(markdownText, vbCr)
On Error Resume Next
' Iterate over each line and process
For i = 0 To UBound(lines)
lines = Trim(lines(i))
' Process the headings
If Left(line, 1) = "#" Then
headerLevel = 0
Do While Mid(line, headerLevel + 1, 1) = "#"
headerLevel = headerLevel + 1
Loop
' Create the header paragraph
Set currentParagraph = ActiveDocument.Content
currentParagraph.Collapse Direction:=wdCollapseEnd
currentParagraph.InsertAfter Trim(Replace(line, "#", "")) & vbCrLf
currentParagraph.Style = ActiveDocument.Styles("Header " & headerLevel)
' Handle bold
ElseIf InStr(line, "**") > 0 Then
line = Replace(line, "**", "")
Set currentParagraph = ActiveDocument.Content
currentParagraph.Collapse Direction:=wdCollapseEnd
currentParagraph.InsertAfter line & vbCrLf
currentParagraph.Font.Bold = True
' Handle Italics
ElseIf InStr(line, "*") > 0 Then
line = Replace(line, "*", "")
Set currentParagraph = ActiveDocument.Content
currentParagraph.Collapse Direction:=wdCollapseEnd
currentParagraph.InsertAfter line & vbCrLf
currentParagraph.Font.Italic = True
' Handle unordered lists
ElseIf Left(line, 1) = "-" Or Left(line, 1) = "*" Then
Set currentParagraph = ActiveDocument.Content
currentParagraph.Collapse Direction:=wdCollapseEnd
currentParagraph.InsertAfter Trim(Mid(line, 2)) & vbCrLf ' Remove the preceding symbols
currentParagraph.ListFormat.ApplyBulletDefault
' Handle ordered lists
ElseIf IsOrderedList(line) Then
Set currentParagraph = ActiveDocument.Content
currentParagraph.Collapse Direction:=wdCollapseEnd
currentParagraph.InsertAfter Trim(line) & vbCrLf
currentParagraph.ListFormat.ApplyNumberDefault
' Handle links
ElseIf InStr(line, "[") > 0 And InStr(line, "]") > 0 Then
Dim linkText As String
Dim linkURL As String
linkText = Mid(line, InStr(line, "[") + 1, InStr(line, "]") - InStr(line, "[") - 1)
linkURL = Mid(line, InStr(line, "(") + 1, InStr(line, ")") - InStr(line, "(") - 1)
Set currentParagraph = ActiveDocument.Content
currentParagraph.Collapse Direction:=wdCollapseEnd
currentParagraph.InsertAfter linkText & vbCrLf
ActiveDocument.Hyperlinks.Add Anchor:=currentParagraph, Address:=linkURL, TextToDisplay:=linkText
' Handling Tables
ElseIf IsMarkdownTable(lines, i) Then
' Handling Tables
ConvertMarkdownToTable lines, i
' Skip the rows of the table
i = i + CountRows(lines, i) + 1 ' skip table headers and separator rows
' Process normal paragraphs
Else
Set currentParagraph = ActiveDocument.Content
currentParagraph.Collapse Direction:=wdCollapseEnd
currentParagraph.InsertAfter line & vbCrLf
End If
End If
End Function
Function IsOrderedList(line As String) As Boolean
Dim parts() As String
parts = Split(line, ".")
' Check if it starts with a number and is followed by a dot
If UBound(parts) > 0 Then
If IsNumeric(Trim(parts(0))) And Len(Trim(parts(0))) > 0 Then
IsOrderedList = True
Exit Function
End If
End If
IsOrderedList = False
End Function
Function IsMarkdownTable(lines() As String, ByRef startIndex As Long) As Boolean
Dim headerLine As String
Dim separatorLine As String
' Check that there are at least three lines (header, separator and at least one row of data)
If UBound(lines) < 2 Then
IsMarkdownTable = False
Exit Function
End If
headerLine = Trim(lines(startIndex))
If InStr(headerLine, "|") = 0 Then
IsMarkdownTable = False
Exit Function
End If
' 检查分隔行是否存在
If startIndex + 1 > UBound(lines) Then
IsMarkdownTable = False
Exit Function
End If
separatorLine = Trim(lines(startIndex + 1))
IsMarkdownTable = True
End Function
Function CountColumns(headerLine As String) As Long
' Count the number of columns, removing the first and the last | '
Dim columns() As String
columns = Split(headerLine, "|")
CountColumns = UBound(columns) - 1 ' Subtract the first and last ones
End Function
Function CountRows(lines() As String, ByVal startIndex As Long) As Long
Dim count As Long
Dim count As Long
' Start at startIndex + 2, skip header and separator rows.
Dim currentIndex As Long
currentIndex = startIndex + 2 ' skip header and separator rows
' Continue checking until the boundary is exceeded
Do While currentIndex <= UBound(lines)
' 检查当前行是否为数据行，忽略分隔行
If Trim(lines(currentIndex) <> "") And InStr(lines(currentIndex), "|") > 0 Then
' Ignore line separators
If Trim(InStr(lines(currentIndex), "|---") = 0) Then
count = count + 1
End If
End If
Exit Do ' If a non-table line is encountered, exit the loop.
End If
currentIndex = currentIndex + 1 ' Move to next row
Loop
CountRows = count
End Function
Sub ConvertMarkdownToTable(lines() As String, startIndex As Long)
Dim i As Long
Dim j As Long
Dim table As table
Dim cellContent As Variant
Dim Dim numRows As Long
Dim numColumns As Long
' Calculate the number of rows and columns
' numRows = UBound(lines) - startIndex - 1 ' Subtract header and separator rows
numRows = CountRows(lines, startIndex)
numColumns = CountColumns(lines(startIndex))
' Make sure the number of rows and columns is valid
If numRows <= 0 Or numColumns <= 0 Then
'MsgBox "Invalid number of table rows or columns." , vbExclamation
Exit Sub
End If
Set MyRange = ActiveDocument.Content
MyRange.Collapse Direction:=wdCollapseEnd
' Create a Word table
Set table = ActiveDocument.Tables.Add(Range:=MyRange, numRows:=numRows + 1, numColumns:=numColumns) ' +1 for table headers
' currentParagraph.InsertAfter table & vbCrLf
' Fill the table header
cellContent = Split(lines(startIndex), "|")
For j = 1 To UBound(cellContent) - 1 ' Ignore the first |, starting at 1.
On Error Resume Next ' Ignore parameter errors.
table.Cell(1, j).Range.text = Trim(cellContent(j)) ' Fill in the table header
On Error GoTo 0 ' Turn off error ignore.
Next j
' Fill the table with data
For i = startIndex + 2 To UBound(lines) ' Fill from rows of data
cellContent = Split(lines(i), "|")
For j = 1 To UBound(cellContent) - 1 ' Ignore the first |, starting from 1
On Error Resume Next ' Ignore parameter errors.
table.Cell(i - startIndex, j).Range.text = Trim(cellContent(j)) ' Fill with data
On Error GoTo 0 ' Turn off error ignore.
Next j
Next i
On Error Resume Next
' Set table borders to 1
With table.Borders
.InsideLineStyle = wdLineStyleSingle
.OutsideLineStyle = wdLineStyleSingle
.InsideLineWidth = 1
.OutsideLineWidth = 1
End With
End Sub
