之前出了一版 ChatGPT For Word 的 MacOS 版本，很多朋友用的是 Windows，问我什么时候可以出，这不来了嘛
Word 因为是微软出品，所以在 Windows 平台更容易集成。
这次我们实验的环境是 Windows 11， Office 2016.
先上效果图：
markdownText = "### 重要信息" & vbCrLf & _
"1. 第一项" & vbCrLf & _
"2. 第二项" & vbCrLf & _
"- 无序项 1" & vbCrLf & _
"- 无序项 2" & vbCrLf & _
"[链接文本](http://example.com "链接文本")" & vbCrLf & _
"这是普通文本。" & vbCrLf & _
"| 列 1 | 列 2 |" & vbCrLf & _
"|-------|-------|" & vbCrLf & _
"| 数据 1 | 数据 2 |" & vbCrLf & _
"| 数据 3 | 数据 4 |"
输出效果如图：
是不是省了很多事情？是不是节约了很多钱？
不再需要切换 APP 不再需要粘贴 不再需要调整样式
我终于感觉到做这个事情的意义了。
下面把我这个开发经历和大家分享一下：
开发环境：
OS：Windows 11 Word：Office Word 2016
大致介绍一下我的开发水平， 20年+ 研发经验：
VBA：10年前写过 Visual Basic
简单概括一下就是我有丰富的编程经验，但是 VBA 比较生疏（以前开发过用 VB 生成 Word 文档，转 PDF），Applescript 没用过。
Windows 版的 VBA 自带访问 HTTP 的库，Mac 版的见我另外一篇文章。
先贴一下VBA的核心代码， Windows 下确实省很多事：
Cursor 编程第一坑：它一直使用 AppleScript 这个方法，虽然我一直提示它有 bug
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 = "请在智谱清言open.bigmodel.cn获取您自己的 API KEY"
'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 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.Range
Else
MsgBox "请先选择内容！"
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)
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
零基础的可以直接下载我提供的文档，然后选择
启用宏
基本用法就是先选中文本，然后按Alt + F8调出宏操作, 选择 ChatGPT即可。
我们这里涉及两个文件，一个是这个 Word 文档，扩展名是docm，表示这个文档包含了宏。
接口返回的是 Markdown 格式，我们需要转 Markdown 格式
Markdown 文档解析我也是花了老大一股劲，用了3-4个晚上才弄好。
目前支持标题、加粗、斜体字、列表、无序列表、表格。
表格花了很多时间，刚开始的时候生成的表格老是跑到最开头。
所以说最靠谱的还是官方文档，至少目前来说特别细的内容从大模型来，还是比较难问得出来。
代码如下：
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 line As String
Dim headerLevel As Integer
Dim currentParagraph As Range
Dim table As table
Dim cellContent() As String
Dim numRows As Long
Dim numColumns As Long
' 将 Markdown 文本按行分割
lines = Split(markdownText, vbCr)
On Error Resume Next
' 遍历每一行并处理
For i = 0 To UBound(lines)
line = Trim(lines(i))
' 处理标题
If Left(line, 1) = "#" Then
headerLevel = 0
Do While Mid(line, headerLevel + 1, 1) = "#"
headerLevel = headerLevel + 1
Loop
' 创建标题段落
Set currentParagraph = ActiveDocument.Content
currentParagraph.Collapse Direction:=wdCollapseEnd
currentParagraph.InsertAfter Trim(Replace(line, "#", "")) & vbCrLf
currentParagraph.Style = ActiveDocument.Styles("标题 " & headerLevel)
' 处理粗体
ElseIf InStr(line, "**") > 0 Then
line = Replace(line, "**", "")
Set currentParagraph = ActiveDocument.Content
currentParagraph.Collapse Direction:=wdCollapseEnd
currentParagraph.InsertAfter line & vbCrLf
currentParagraph.Font.Bold = True
' 处理斜体
ElseIf InStr(line, "*") > 0 Then
line = Replace(line, "*", "")
Set currentParagraph = ActiveDocument.Content
currentParagraph.Collapse Direction:=wdCollapseEnd
currentParagraph.InsertAfter line & vbCrLf
currentParagraph.Font.Italic = True
' 处理无序列表
ElseIf Left(line, 1) = "-" Or Left(line, 1) = "*" Then
Set currentParagraph = ActiveDocument.Content
currentParagraph.Collapse Direction:=wdCollapseEnd
currentParagraph.InsertAfter Trim(Mid(line, 2)) & vbCrLf ' 去掉前面的符号
currentParagraph.ListFormat.ApplyBulletDefault
' 处理有序列表
ElseIf IsOrderedList(line) Then
Set currentParagraph = ActiveDocument.Content
currentParagraph.Collapse Direction:=wdCollapseEnd
currentParagraph.InsertAfter Trim(line) & vbCrLf
currentParagraph.ListFormat.ApplyNumberDefault
' 处理链接
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
' 处理表格
ElseIf IsMarkdownTable(lines, i) Then
' 处理表格
ConvertMarkdownToTable lines, i
' 跳过表格的行
i = i + CountRows(lines, i) + 1 ' 跳过表头和分隔行
' 处理普通段落
Else
Set currentParagraph = ActiveDocument.Content
currentParagraph.Collapse Direction:=wdCollapseEnd
currentParagraph.InsertAfter line & vbCrLf
End If
Next i
End Function
Function IsOrderedList(line As String) As Boolean
Dim parts() As String
parts = Split(line, ".")
' 检查是否以数字开头并且后面跟着一个点
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
' 检查至少有三行（表头、分隔行和至少一行数据）
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
' 计算列数，去掉第一个和最后一个 |
Dim columns() As String
columns = Split(headerLine, "|")
CountColumns = UBound(columns) - 1 ' 减去第一个和最后一个
End Function
Function CountRows(lines() As String, ByVal startIndex As Long) As Long
Dim count As Long
count = 0
' 从 startIndex + 2 开始，跳过表头和分隔行
Dim currentIndex As Long
currentIndex = startIndex + 2 ' 跳过表头和分隔行
' 继续检查直到超出边界
Do While currentIndex <= UBound(lines)
' 检查当前行是否为数据行，忽略分隔行
If Trim(lines(currentIndex) <> "") And InStr(lines(currentIndex), "|") > 0 Then
' 忽略分隔行
If Trim(InStr(lines(currentIndex), "|---") = 0) Then
count = count + 1
End If
Else
Exit Do ' 如果遇到非表格行，退出循环
End If
currentIndex = currentIndex + 1 ' 移动到下一行
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 numRows As Long
Dim numColumns As Long
' 计算行数和列数
'numRows = UBound(lines) - startIndex - 1 ' 减去表头和分隔行
numRows = CountRows(lines, startIndex)
numColumns = CountColumns(lines(startIndex))
' 确保行数和列数有效
If numRows <= 0 Or numColumns <= 0 Then
'MsgBox "表格行数或列数无效。", vbExclamation
Exit Sub
End If
Set MyRange = ActiveDocument.Content
MyRange.Collapse Direction:=wdCollapseEnd
' 创建 Word 表格
Set table = ActiveDocument.Tables.Add(Range:=MyRange, numRows:=numRows + 1, numColumns:=numColumns) ' +1 用于表头
'currentParagraph.InsertAfter table & vbCrLf
' 填充表头
cellContent = Split(lines(startIndex), "|")
For j = 1 To UBound(cellContent) - 1 ' 从 1 开始，忽略第一个 |
On Error Resume Next ' 忽略参数错误
table.Cell(1, j).Range.text = Trim(cellContent(j)) ' 填充表头
On Error GoTo 0 ' 关闭错误忽略
Next j
' 填充表格数据
For i = startIndex + 2 To UBound(lines) ' 从数据行开始填充
cellContent = Split(lines(i), "|")
For j = 1 To UBound(cellContent) - 1 ' 从 1 开始，忽略第一个 |
On Error Resume Next ' 忽略参数错误
table.Cell(i - startIndex, j).Range.text = Trim(cellContent(j)) ' 填充数据
On Error GoTo 0 ' 关闭错误忽略
Next j
Next i
On Error Resume Next
' 设置表格边框为 1
With table.Borders
.InsideLineStyle = wdLineStyleSingle
.OutsideLineStyle = wdLineStyleSingle
.InsideLineWidth = 1
.OutsideLineWidth = 1
End With
End Sub
总结：
最后简单总结一下 Cursor 开发的坑：
Cursor 修 Bug，摁下葫芦起了漂。后来我优化提示词，把所有的需要的问题都列出来 Cursor 或者 ChatGPT 的水平有时候也有限。VBA 处理表格的时候无论怎么修改提示词，出来的表格都有问题，后来我还是用老办法，逐行调试，解决了一下。 新建的表格刚开始老是放在最前面。刚开始想着忍忍算了，后来觉得实在不能让。无奈 Cursor 虽然总是承认自己修改好了，但是一调试一点用都没有。我说你可以自己跑跑，看有没有问题，结果，他耍起赖来了：“不好意思，我没有环境”。一副死猪不怕开水烫的样子。后来我还是用最古老的办法，看看官方 VBA 开发的文档，参数的意思，修改了一下，终于好了。 Cursor 或者说 ChatGPT 可以在不熟悉的领域帮我们快速的完成原型，但是目前来说并不太靠谱。同样的提示词返回的代码质量千差万别。 我觉得算是老司机的一个导航吧，连助理还差可靠性和理解力。
支持图片提问。复制图片，上传至智谱接口，返回结果 支持表格提问。同上 后续会出 AI For Excel、AI for PPT
