Para aqueles que não podem pagar uma associação de copiloto ou uma associação de WPS AI e ainda querem experimentar o texto contínuo em um documento, é possível fazer isso com o código de macro.
Duas versões estão disponíveis abaixo para MacOS e Windows:
1. modifique a chave de API e substitua-a por um modelo gratuito.
2) O uso básico é selecionar o texto primeiro e, em seguida, pressionar a teclaAlt + F8Chame a operação de macro, selecione ChatGPTPronto para começar.
código principal
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"
'Digite sua chave de API
api_key = "Obtenha sua própria chave de API em open.bigmodel.cn"
'Nome do modelo
modelName = "glm-4-plus"
systemPrompt = "Você é um bot de bate-papo útil que tem experiência em WORD. Não escreva explicações nas respostas. A saída deve ser no formato markdown sem markdown."
If api_key = "" Then
MsgBox "Erro: a chave da API está em branco!"
Exit Sub
Fim do caso
' Solicitar que o usuário selecione o texto no documento
Se Selection.Type wdSelectionIP Then
prompt = Trim(Selection.text)
Set selectedText = Selection.Range
Set selectedText = Selection.Range
MsgBox "Por favor, selecione o conteúdo primeiro!"
Exit Sub
End If
'Limpeza
text = Replace(prompt, Chr(34), Chr(39))
text = Replace(text, vbLf, "")
text = Replace(text, vbCr, "")
text = Replace(text, vbCrLf, "")
' Remover a seleção
Selection.Collapse
' Criar um objeto de solicitação HTTP
Definir solicitação = CreateObject("MSXML2.XMLHTTP")
Com a solicitação
.abrir "POST", API, False
.setRequestHeader "Content-Type", "application/json"
.setRequestHeader "Authorisation", "Bearer " & api_key
.send "{""model"":""" & modelName & """, ""messages"": [{""content"":""" & systemPrompt & """,""role"":""system""},{" & _
"""content"":""" & text & ""","" & role"":"""user""}],"""temperature"": 1}""
status_code = .Status
response = .responseText
Fim com
'Extrair conteúdo
If status_code = 200 Then
DisplayText = ExtractContent(response)
'Inserir o texto da resposta no documento do Word
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)
Caso contrário
DisplayText = ""
End If
'Inserir mensagem de erro no documento do Word
EDisplayText = "Erro: " & DisplayText
selectedText.InsertAfter vbNewLine & EDisplayText
Fim Se
'Limpar o objeto
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>Introdução ao bot de bate-papo</title>\n</head>\n<body>\n<h1>Olá!</h1>\n<p>Sou um bot de bate-papo útil com experiência em 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
Função final
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 numRows As Long
Dim numColumns As Long
' Dividir o texto do Markdown por linhas
lines = Split(markdownText, vbCr)
On Error Resume Next
' Iterar em cada linha e processar
For i = 0 To UBound(lines)
lines = Trim(lines(i))
' Processar os cabeçalhos
If Left(line, 1) = "#" Then
headerLevel = 0
Do While Mid(line, headerLevel + 1, 1) = "#"
headerLevel = headerLevel + 1
Loop
' Criar o parágrafo do cabeçalho
Set currentParagraph = ActiveDocument.Content
currentParagraph.Collapse Direction:=wdCollapseEnd
currentParagraph.InsertAfter Trim(Replace(line, "#", "")) & vbCrLf
currentParagraph.Style = ActiveDocument.Styles("Header " & headerLevel)
' Manipular o negrito
ElseIf InStr(line, "**") > 0 Then
line = Replace(line, "**", "")
Set currentParagraph = ActiveDocument.Content
currentParagraph.Collapse Direction:=wdCollapseEnd
currentParagraph.InsertAfter line & vbCrLf
currentParagraph.Font.Bold = True
' Manipular itálico
ElseIf InStr(line, "*") > 0 Then
line = Replace(line, "*", "")
Set currentParagraph = ActiveDocument.Content
currentParagraph.Collapse Direction:=wdCollapseEnd
currentParagraph.InsertAfter line & vbCrLf
currentParagraph.Font.Italic = True
' Lidar com listas não ordenadas
ElseIf Left(line, 1) = "-" Or Left(line, 1) = "*" Then
Set currentParagraph = ActiveDocument.Content
currentParagraph.Collapse Direction:=wdCollapseEnd
currentParagraph.InsertAfter Trim(Mid(line, 2)) & vbCrLf ' Remover os símbolos anteriores
currentParagraph.ListFormat.ApplyBulletDefault
' Lidar com listas ordenadas
ElseIf IsOrderedList(line) Then
Set currentParagraph = ActiveDocument.Content
currentParagraph.Collapse Direction:=wdCollapseEnd
currentParagraph.InsertAfter Trim(line) & vbCrLf
currentParagraph.ListFormat.ApplyNumberDefault
' Manipular 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)
Definir currentParagraph = ActiveDocument.Content
currentParagraph.Collapse Direction:=wdCollapseEnd
currentParagraph.InsertAfter linkText & vbCrLf
ActiveDocument.Hyperlinks.Add Anchor:=currentParagraph, Address:=linkURL, TextToDisplay:=linkText
' Manipulação de tabelas
ElseIf IsMarkdownTable(lines, i) Then
' Manuseio de tabelas
ConvertMarkdownToTable lines, i
' Pular as linhas da tabela
i = i + CountRows(lines, i) + 1 ' Ignorar cabeçalhos de tabela e linhas separadoras
' Processar parágrafos normais
Caso contrário
Definir currentParagraph = ActiveDocument.Content
currentParagraph.Collapse Direction:=wdCollapseEnd
currentParagraph.InsertAfter line & vbCrLf
End If
End If
Função final
Function IsOrderedList(line As String) As Boolean
Dim parts() As String
parts = Split(line, ".")
' Verificar se começa com um número e é seguido por um ponto
If UBound(parts) > 0 Then
If IsNumeric(Trim(parts(0))) And Len(Trim(parts(0))) > 0 Then
IsOrderedList = True
Sair da função
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
' Verificar se há pelo menos três linhas (cabeçalho, separador e pelo menos uma linha de dados)
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
Sair da função
End If
separatorLine = Trim(lines(startIndex + 1))
IsMarkdownTable = True
Função final
Function CountColumns(headerLine As String) As Long
' Contar o número de colunas, removendo a primeira e a última
Dim columns() As String
columns = Split(headerLine, "|")
CountColumns = UBound(columns) - 1 ' Subtrair a primeira e a última coluna
Função final
Function CountRows(lines() As String, ByVal startIndex As Long) As Long
Dim count As Long
ByVal startIndex As Long
' Iniciar em startIndex + 2, ignorar linhas de cabeçalho e separadoras.
Dim currentIndex As Long
currentIndex = startIndex + 2 ' Pular as linhas de cabeçalho e de separação
' Continue verificando até que o limite seja ultrapassado
Do While currentIndex <= UBound(lines)
' 检查当前行是否为数据行，忽略分隔行
If Trim(lines(currentIndex) <> "") And InStr(lines(currentIndex), "|") > 0 Then
' Ignorar separadores de linha
If Trim(InStr(lines(currentIndex), "|---") = 0) Then
count = count + 1
End If
End If
Exit Do ' Se for encontrada uma linha que não seja de tabela, saia do loop.
End If
currentIndex = currentIndex + 1 ' Passar para a próxima linha
Loop
CountRows = count
Função final
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
' Calcular o número de linhas e colunas
' numRows = UBound(lines) - startIndex - 1 ' Subtrair as linhas do cabeçalho e do separador
numRows = CountRows(lines, startIndex)
numColumns = CountColumns(lines(startIndex))
' Verificar se o número de linhas e colunas é válido
Se numRows <= 0 Or numColumns <= 0 Then
'MsgBox "Número inválido de linhas ou colunas da tabela." , vbExclamation
Exit Sub
End If
Set MyRange = ActiveDocument.Content
MyRange.Collapse Direction:=wdCollapseEnd
' Criar uma tabela do Word
Set table = ActiveDocument.Tables.Add(Range:=MyRange, numRows:=numRows + 1, numColumns:=numColumns) ' +1 para o cabeçalho da tabela
' currentParagraph.InsertAfter table & vbCrLf
' Preencher o cabeçalho da tabela
cellContent = Split(lines(startIndex), "|")
For j = 1 To UBound(cellContent) - 1 ' Ignorar o primeiro |, começando em 1
On Error Resume Next ' Ignorar erros de parâmetro.
table.Cell(1, j).Range.text = Trim(cellContent(j)) ' Preencher o cabeçalho da tabela
On Error GoTo 0 ' Desativar a ignorância de erros.
Próximo j
' Preencher a tabela com dados
For i = startIndex + 2 To UBound(lines) ' Preencher com as linhas de dados
cellContent = Split(lines(i), "|")
For j = 1 To UBound(cellContent) - 1 ' Ignorar o primeiro |, começando em 1
On Error Resume Next ' Ignorar erros de parâmetro.
table.Cell(i - startIndex, j).Range.text = Trim(cellContent(j)) ' Preencher os dados
On Error GoTo 0 ' Desativar o erro ignorado.
Próximo j
Próximo i
On Error Resume Next
' Definir as bordas da tabela como 1
Com table.Borders
.InsideLineStyle = wdLineStyleSingle
.OutsideLineStyle = wdLineStyleSingle
.InsideLineWidth = 1
.OutsideLineWidth = 1
Finalizar com
End Sub
