千呼万唤的Word 集成智谱大模型来了，WPS AI 会员可以不要了 - 链载Ai

之前出了一版 ChatGPT For Word 的 MacOS 版本，很多朋友用的是 Windows，问我什么时候可以出，这不来了嘛

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

SubchatGPTWord()

DimrequestAsObject
DimtextAsString,responseAsString,APIAsString,api_keyAsString,DisplayTextAsString,error_resultAsString
DimstartPosAsLong,status_codeAsLong
DimpromptAsString
DimselectedTextAsRange

API="https://open.bigmodel.cn/api/paas/v4/chat/completions"

'EnterYourAPIKey
api_key="请在智谱清言open.bigmodel.cn获取您自己的APIKEY"

'ModelName
modelName="glm-4-plus"

systemPrompt="YouareahelpfulchatbotthathasexpertiseinWORD.Donotwriteexplanationsonreplies.Outputshouldbemarkdownformatwithoutmarkdown."

Ifapi_key=""Then
MsgBox"Error:APIkeyisblank!"
ExitSub
EndIf

'rompttheusertoselecttextinthedocument
IfSelection.Type<>wdSelectionIPThen
prompt=Trim(Selection.text)
SetselectedText=Selection.Range
Else
 MsgBox "请先选择内容！"
ExitSub
EndIf

'Cleaning
text=Replace(prompt,Chr(34),Chr(39))
text=Replace(text,vbLf,"")
text=Replace(text,vbCr,"")
text=Replace(text,vbCrLf,"")

'Removeselection
Selection.Collapse

'CreateanHTTPrequestobject
Setrequest=CreateObject("MSXML2.XMLHTTP")
Withrequest
.Open"OST",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
EndWith
'Extractcontent
Ifstatus_code=200Then
DisplayText=ExtractContent(response)

'InsertresponsetextintoWorddocument
selectedText.InsertAftervbNewLine&ConvertMarkdownToWord(DisplayText)


Else
startPos=InStr(response,"""message"":""")+Len("""message"":""")
endPos=InStr(startPos,response,"""")
IfstartPos>Len("""message"":""")AndendPos>startPosThen
DisplayText=Mid(response,startPos,endPos-startPos)
Else
DisplayText=""
EndIf

'InserterrormessageintoWorddocument
EDisplayText="Error:"&DisplayText
selectedText.InsertAftervbNewLine&EDisplayText

EndIf


'Cleanuptheobject
Setrequest=Nothing

EndSub

零基础的可以直接下载我提供的文档，然后选择启用宏

基本用法就是先选中文本，然后按Alt + F8调出宏操作, 选择 ChatGPT即可。

我们这里涉及两个文件，一个是这个 Word 文档，扩展名是docm，表示这个文档包含了宏。

接口返回的是 Markdown 格式，我们需要转 Markdown 格式

Markdown 文档解析我也是花了老大一股劲，用了3-4个晚上才弄好。

目前支持标题、加粗、斜体字、列表、无序列表、表格。

表格花了很多时间，刚开始的时候生成的表格老是跑到最开头。

所以说最靠谱的还是官方文档，至少目前来说特别细的内容从大模型来，还是比较难问得出来。

代码如下：



FunctionExtractContent(jsonStringAsString)AsString
DimstartPosAsLong
DimendPosAsLong
DimContentAsString

'{"choices":[{"finish_reason":"stop","index":0,"message":{"content":"<html>\n<head>\n<title>ChatBotIntroduction</title>\n</head>\n<body>\n<h1>Hello!</h1>\n<p>IamahelpfulchatbotwithexpertiseinHTML.</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)

IfRight(Content,1)=""""Then
Content=Left(Content,Len(Content)-1)
EndIf

ExtractContent=Content

EndFunction

FunctionConvertMarkdownToWord(markdownTextAsString)
Dimlines()AsString
DimiAsLong
DimlineAsString
DimheaderLevelAsInteger
DimcurrentParagraphAsRange
DimtableAstable
DimcellContent()AsString
DimnumRowsAsLong
DimnumColumnsAsLong

'将Markdown文本按行分割
lines=Split(markdownText,vbCr)

OnErrorResumeNext
'遍历每一行并处理
Fori=0ToUBound(lines)
line=Trim(lines(i))

'处理标题
IfLeft(line,1)="#"Then
headerLevel=0
DoWhileMid(line,headerLevel+1,1)="#"
headerLevel=headerLevel+1
Loop
'创建标题段落
SetcurrentParagraph=ActiveDocument.Content
currentParagraph.CollapseDirection:=wdCollapseEnd
currentParagraph.InsertAfterTrim(Replace(line,"#",""))&vbCrLf
currentParagraph.Style=ActiveDocument.Styles("标题"&headerLevel)

'处理粗体
ElseIfInStr(line,"**")>0Then
line=Replace(line,"**","")
SetcurrentParagraph=ActiveDocument.Content
currentParagraph.CollapseDirection:=wdCollapseEnd
currentParagraph.InsertAfterline&vbCrLf
currentParagraph.Font.Bold=True

'处理斜体
ElseIfInStr(line,"*")>0Then
line=Replace(line,"*","")
SetcurrentParagraph=ActiveDocument.Content
currentParagraph.CollapseDirection:=wdCollapseEnd
currentParagraph.InsertAfterline&vbCrLf
currentParagraph.Font.Italic=True

'处理无序列表
ElseIfLeft(line,1)="-"OrLeft(line,1)="*"Then
SetcurrentParagraph=ActiveDocument.Content
currentParagraph.CollapseDirection:=wdCollapseEnd
currentParagraph.InsertAfterTrim(Mid(line,2))&vbCrLf'去掉前面的符号
currentParagraph.ListFormat.ApplyBulletDefault

'处理有序列表
ElseIfIsOrderedList(line)Then
SetcurrentParagraph=ActiveDocument.Content
currentParagraph.CollapseDirection:=wdCollapseEnd
currentParagraph.InsertAfterTrim(line)&vbCrLf
currentParagraph.ListFormat.ApplyNumberDefault

'处理链接
ElseIfInStr(line,"[")>0AndInStr(line,"]")>0Then
DimlinkTextAsString
DimlinkURLAsString
linkText=Mid(line,InStr(line,"[")+1,InStr(line,"]")-InStr(line,"[")-1)
linkURL=Mid(line,InStr(line,"(")+1,InStr(line,")")-InStr(line,"(")-1)
SetcurrentParagraph=ActiveDocument.Content
currentParagraph.CollapseDirection:=wdCollapseEnd
currentParagraph.InsertAfterlinkText&vbCrLf
ActiveDocument.Hyperlinks.AddAnchor:=currentParagraph,Address:=linkURL,TextToDisplay:=linkText

'处理表格
ElseIfIsMarkdownTable(lines,i)Then
'处理表格
ConvertMarkdownToTablelines,i
'跳过表格的行
i=i+CountRows(lines,i)+1'跳过表头和分隔行
'处理普通段落
Else
SetcurrentParagraph=ActiveDocument.Content
currentParagraph.CollapseDirection:=wdCollapseEnd
currentParagraph.InsertAfterline&vbCrLf
EndIf
Nexti
EndFunction

FunctionIsOrderedList(lineAsString)AsBoolean
Dimparts()AsString
parts=Split(line,".")

'检查是否以数字开头并且后面跟着一个点
IfUBound(parts)>0Then
IfIsNumeric(Trim(parts(0)))AndLen(Trim(parts(0)))>0Then
IsOrderedList=True
ExitFunction
EndIf
EndIf

IsOrderedList=False
EndFunction

FunctionIsMarkdownTable(lines()AsString,ByRefstartIndexAsLong)AsBoolean
DimheaderLineAsString
DimseparatorLineAsString

'检查至少有三行（表头、分隔行和至少一行数据）
IfUBound(lines)<2Then
IsMarkdownTable=False
ExitFunction
EndIf

headerLine=Trim(lines(startIndex))
IfInStr(headerLine,"|")=0Then
IsMarkdownTable=False
ExitFunction
EndIf

'检查分隔行是否存在
IfstartIndex+1>UBound(lines)Then
IsMarkdownTable=False
ExitFunction
EndIf

separatorLine=Trim(lines(startIndex+1))

IsMarkdownTable=True
EndFunction

FunctionCountColumns(headerLineAsString)AsLong
'计算列数，去掉第一个和最后一个|
Dimcolumns()AsString
columns=Split(headerLine,"|")
CountColumns=UBound(columns)-1'减去第一个和最后一个
EndFunction

FunctionCountRows(lines()AsString,ByValstartIndexAsLong)AsLong
DimcountAsLong
count=0

'从startIndex+2开始，跳过表头和分隔行
DimcurrentIndexAsLong
currentIndex=startIndex+2'跳过表头和分隔行

'继续检查直到超出边界
DoWhilecurrentIndex<=UBound(lines)
'检查当前行是否为数据行，忽略分隔行
IfTrim(lines(currentIndex)<>"")AndInStr(lines(currentIndex),"|")>0Then
'忽略分隔行
IfTrim(InStr(lines(currentIndex),"|---")=0)Then
count=count+1
EndIf
Else
ExitDo'如果遇到非表格行，退出循环
EndIf
currentIndex=currentIndex+1'移动到下一行
Loop

CountRows=count
EndFunction

SubConvertMarkdownToTable(lines()AsString,startIndexAsLong)
DimiAsLong
DimjAsLong
DimtableAstable
DimcellContentAsVariant
DimnumRowsAsLong
DimnumColumnsAsLong

'计算行数和列数
'numRows=UBound(lines)-startIndex-1'减去表头和分隔行
numRows=CountRows(lines,startIndex)
numColumns=CountColumns(lines(startIndex))

'确保行数和列数有效
IfnumRows<=0OrnumColumns<=0Then
'MsgBox "表格行数或列数无效。", vbExclamation
ExitSub
EndIf

SetMyRange=ActiveDocument.Content
MyRange.CollapseDirection:=wdCollapseEnd
'创建Word表格
Settable=ActiveDocument.Tables.Add(Range:=MyRange,numRows:=numRows+1,numColumns:=numColumns)'+1用于表头

'currentParagraph.InsertAftertable&vbCrLf

'填充表头
cellContent=Split(lines(startIndex),"|")
Forj=1ToUBound(cellContent)-1'从1开始，忽略第一个|
OnErrorResumeNext'忽略参数错误
table.Cell(1,j).Range.text=Trim(cellContent(j))'填充表头
OnErrorGoTo0'关闭错误忽略
Nextj

'填充表格数据
Fori=startIndex+2ToUBound(lines)'从数据行开始填充
cellContent=Split(lines(i),"|")
Forj=1ToUBound(cellContent)-1'从1开始，忽略第一个|
OnErrorResumeNext'忽略参数错误
table.Cell(i-startIndex,j).Range.text=Trim(cellContent(j))'填充数据
OnErrorGoTo0'关闭错误忽略
Nextj
Nexti

OnErrorResumeNext
'设置表格边框为1
Withtable.Borders
.InsideLineStyle=wdLineStyleSingle
.OutsideLineStyle=wdLineStyleSingle
.InsideLineWidth=1
.OutsideLineWidth=1
EndWith

EndSub

总结：

最后简单总结一下 Cursor 开发的坑：

Cursor 修 Bug，摁下葫芦起了漂。后来我优化提示词，把所有的需要的问题都列出来
Cursor 或者 ChatGPT 的水平有时候也有限。VBA 处理表格的时候无论怎么修改提示词，出来的表格都有问题，后来我还是用老办法，逐行调试，解决了一下。
新建的表格刚开始老是放在最前面。刚开始想着忍忍算了，后来觉得实在不能让。无奈 Cursor 虽然总是承认自己修改好了，但是一调试一点用都没有。我说你可以自己跑跑，看有没有问题，结果，他耍起赖来了：“不好意思，我没有环境”。一副死猪不怕开水烫的样子。后来我还是用最古老的办法，看看官方 VBA 开发的文档，参数的意思，修改了一下，终于好了。
Cursor 或者说 ChatGPT 可以在不熟悉的领域帮我们快速的完成原型，但是目前来说并不太靠谱。同样的提示词返回的代码质量千差万别。
我觉得算是老司机的一个导航吧，连助理还差可靠性和理解力。

TODO：

程序员的老习惯~

支持图片提问。复制图片，上传至智谱接口，返回结果
支持表格提问。同上
后续会出 AI For Excel、AI for PPT