Kostenloser Bettel-Kopilot in Word zur Unterstützung der Textfortsetzung

🚀 DeepSeek verzögert? Diese Seite ist kostenlos! Vollblütiger DeepSeek-R1, reibungslos und netzwerkfähig! Unbegrenzte Nutzung!

Wer sich eine Copilot- oder WPS AI-Mitgliedschaft nicht leisten kann und trotzdem Fließtext in einem Dokument erleben möchte, kann dies mit Makrocode tun.

Zwei Versionen sind unten für MacOS und Windows verfügbar:

Dieser Inhalt wurde vom Autor versteckt. Bitte geben Sie den Verifizierungscode ein, um den Inhalt zu sehen.

Bitte beachten Sie diese Website WeChat öffentliche Nummer, Antwort "CAPTCHA, eine Art Challenge-Response-Test (Computer)", erhalten Sie den Verifizierungscode. Suchen Sie in WeChat nach "Chef-KI-Austauschkreis"oder"Looks-AI" oder WeChat, indem Sie die rechte Seite des QR-Codes scannen, können Sie die öffentliche WeChat-Nummer dieser Website aufrufen.

1. bitte ändern Sie den API-Schlüssel und ersetzen Sie ihn durch ein freies Modell.

(2) Grundsätzlich wird der Text zuerst markiert und dann die TasteAlt + F8Rufen Sie die Makrooperation auf, wählen Sie ChatGPTEs kann losgehen.

Kern-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"

    'Geben Sie Ihren API-Schlüssel ein
    api_key = "Bitte holen Sie sich Ihren eigenen API-Schlüssel bei open.bigmodel.cn"

    Modellname
    modelName = "glm-4-plus"

    systemPrompt = "Du bist ein hilfreicher Chatbot, der sich mit WORD auskennt. Schreibe keine Erklärungen in die Antworten. output should be markdown format without Die Ausgabe sollte im Markdown-Format ohne Markdown erfolgen."

    If api_key = "" Then
        MsgBox "Fehler: API-Schlüssel ist leer!"
        Exit Sub
    End If

    ' Aufforderung an den Benutzer, Text im Dokument auszuwählen
    If Selection.Type  wdSelectionIP Then
        prompt = Trim(Auswahl.Text)
        Set selectedText = Selection.Range
    Selection.text Then prompt = Trim(Selection.text) Set selectedText = Selection.
        MsgBox "Bitte wählen Sie zuerst den Inhalt aus!"
        Exit Sub
    End If

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

    ' Auswahl aufheben
    Selection.Collapse

    ' Ein HTTP-Anfrageobjekt erstellen
    Set request = CreateObject("MSXML2.XMLHTTP")
    Mit request
        .Open "POST", API, False
        .setRequestHeader "Inhalts-Typ", "anwendung/json"
        .setRequestHeader "Authorisation", "Bearer " & api_key
        .send "{""model"":""" & modelName & """, ""messages"": [{""content"":""" & systemPrompt & """,""role"":""system""},{" & _
                    """content"":""" & text & ""","" & role"":"""user""}],"""temperature"": 1}""
            status_code = .Status
            Antwort = .responseText
    Ende mit
      'Inhalt extrahieren
    Wenn status_code = 200 Dann
      DisplayText = ExtractContent(response)

      'Antworttext in Word-Dokument einfügen
      selectedText.InsertAfter vbNewLine & ConvertMarkdownToWord(DisplayText)


    StartPos = InStr(Antwort, "")
        startPos = InStr(Antwort, """Nachricht"": """) + Len("""Nachricht"": """)
        endPos = InStr(startPos, antwort, """")
        If startPos > Len("""message"": """) And endPos > startPos Then
            DisplayText = Mid(Antwort, startPos, endPos - startPos)
        Sonst
            DisplayText = ""
        Ende Wenn

        'Fehlermeldung in Word-Dokument einfügen
        EDisplayText = "Fehler : " & DisplayText
        selectedText.InsertAfter vbNewLine & EDisplayText

    End If


    'Das Objekt aufräumen
    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 Einführung</title>\n</head>\n<body>\n<h1>Hallo!</h1>\n<p>Ich bin ein hilfsbereiter Chatbot mit Fachkenntnissen in HTML.</p>\n</body>\n</html>", "Rolle": "Assistent"}}],""

    startPos = InStr(1, jsonString, """Inhalt"":""") + Len("""Inhalt"": """)
    endPos = InStr(startPos, jsonString, ","""Rolle"":""") - 2
    Inhalt = Mid(jsonString, startPos, endPos - startPos)
    Inhalt = Trim(Replace(Inhalt, "\""", Chr(34)))

    Inhalt = Replace(Inhalt, vbCrLf, "")
    Inhalt = Replace(Inhalt, vbLf, "")
    Inhalt = Replace(Inhalt, vbCr, "")
    Inhalt = Replace(Inhalt, "\n", vbCrLf)

    If Right(Content, 1) = """" Then
      Inhalt = Links(Inhalt, Len(Inhalt) - 1)
    Ende Wenn

    ExtraktInhalt = Inhalt

Ende Funktion

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

    ' Markdown-Text nach Zeilen aufteilen
    lines = Split(markdownText, vbCr)

    On Error Resume Next
    ' Iterieren über jede Zeile und verarbeiten
    For i = 0 To UBound(lines)
        lines = Trim(lines(i))

        ' Verarbeiten der Überschriften
        If Left(Zeile, 1) = "#" Then
            headerLevel = 0
            Do While Mid(Zeile, KopfzeileLevel + 1, 1) = "#"
                headerLevel = headerLevel + 1
            Schleife
            ' Erzeugen des Kopfabsatzes
            Set currentParagraph = ActiveDocument.Content
            currentParagraph.Collapse Direction:=wdCollapseEnd
            currentParagraph.InsertAfter Trim(Replace(line, "#", "")) &amp; vbCrLf
            currentParagraph.Style = ActiveDocument.Styles("Kopfzeile" &amp; headerLevel)

        ' Fettschrift behandeln
        ElseIf InStr(Zeile, "**") &gt; 0 Then
            Zeile = Ersetzen(Zeile, "**", "")
            Set currentParagraph = ActiveDocument.Content
            currentParagraph.Collapse Direction:=wdCollapseEnd
            currentParagraph.InsertAfter Zeile &amp; vbCrLf
            currentParagraph.Font.Bold = True

        ' Kursivschrift behandeln
        ElseIf InStr(line, "*") &gt; 0 Then
            Zeile = Ersetzen(Zeile, "*", "")
            Set currentParagraph = ActiveDocument.Content
            currentParagraph.Collapse Direction:=wdCollapseEnd
            currentParagraph.InsertAfter Zeile &amp; vbCrLf
            currentParagraph.Font.Italic = True

        ' Nicht geordnete Listen behandeln
        ElseIf Left(line, 1) = "-" Or Left(line, 1) = "*" Then
            Set currentParagraph = ActiveDocument.Content
            currentParagraph.Collapse Direction:=wdCollapseEnd
            currentParagraph.InsertAfter Trim(Mid(line, 2)) &amp; vbCrLf ' Die vorangehenden Symbole entfernen
            currentParagraph.ListFormat.ApplyBulletDefault

        ' Geordnete Listen handhaben
        ElseIf IsOrderedList(line) Then
            Set currentParagraph = ActiveDocument.Content
            currentParagraph.Collapse Direction:=wdCollapseEnd
            currentParagraph.InsertAfter Trim(Zeile) &amp; vbCrLf
            currentParagraph.ListFormat.ApplyNumberDefault

        ' Links behandeln
        ElseIf InStr(line, "[") &gt; 0 And InStr(line, "]") &gt; 0 Then
            Dim linkText As String
            Dim linkURL As String
            linkText = Mid(Zeile, InStr(Zeile, "[") + 1, InStr(Zeile, "]") - InStr(Zeile, "[") - 1)
            linkURL = Mid(Zeile, InStr(Zeile, "(") + 1, InStr(Zeile, ")") - InStr(Zeile, "(") - 1)
            Set currentParagraph = ActiveDocument.Content
            currentParagraph.Collapse Direction:=wdCollapseEnd
            currentParagraph.InsertAfter linkText &amp; vbCrLf
            ActiveDocument.Hyperlinks.Add Anker:=aktuellerAbsatz, Adresse:=linkURL, TextZurAnzeige:=linkText

        ' Behandlung von Tabellen
        ElseIf IsMarkdownTable(lines, i) Then
            ' Handhabung von Tabellen
            ConvertMarkdownToTable Zeilen, i
            ' Die Zeilen der Tabelle überspringen
            i = i + CountRows(lines, i) + 1 ' Tabellenköpfe und Trennzeilen überspringen
        ' Normale Absätze verarbeiten
        Else
            Set currentParagraph = ActiveDocument.Content
            currentParagraph.Collapse Direction:=wdCollapseEnd
            currentParagraph.InsertAfter Zeile &amp; vbCrLf
        End If
    Ende Wenn
Ende Funktion

Function IsOrderedList(line As String) As Boolean
    Dim parts() As String
    parts = Split(line, ".")

    ' Prüfen, ob die Zeile mit einer Zahl beginnt und von einem Punkt gefolgt wird
    If UBound(parts) &gt; 0 Then
        If IsNumeric(Trim(parts(0))) And Len(Trim(parts(0))) &gt; 0 Then
            IsOrderedList = Wahr
            Funktion beenden
        Ende Wenn
    Ende Wenn

    IsOrderedList = False
Ende Funktion

Function IsMarkdownTable(lines() As String, ByRef startIndex As Long) As Boolean
    Dim headerLine As String
    Dim separatorLine As String

    ' Prüfen, ob mindestens drei Zeilen vorhanden sind (Kopfzeile, Trennlinie und mindestens eine Zeile mit Daten)
    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
        Funktion beenden
    Ende Wenn

    separatorLine = Trim(lines(startIndex + 1))

    IsMarkdownTable = Wahr
Funktion beenden

Function CountColumns(headerLine As String) As Long
    ' Zähle die Anzahl der Spalten und entferne dabei die erste und die letzte Spalte | '
    Dim columns() As String
    columns = Split(headerLine, "|")
    CountColumns = UBound(columns) - 1 ' Erste und letzte Spalte subtrahieren
Funktion beenden

Function CountRows(lines() As String, ByVal startIndex As Long) As Long
    Dim count As Long
    ByVal startIndex As Long

    ' Beginnt bei startIndex + 2, überspringt Kopf- und Trennzeilen.
    Dim currentIndex As Long
    currentIndex = startIndex + 2 ' Überspringen von Kopf- und Trennzeilen

    ' Prüfung fortsetzen, bis die Grenze überschritten ist
    Do While currentIndex <= UBound(lines)
        ' 检查当前行是否为数据行，忽略分隔行
        If Trim(lines(currentIndex) <> "") And InStr(lines(currentIndex), "|") &gt; 0 Then
            ' Zeilentrenner ignorieren
            If Trim(InStr(lines(currentIndex), "|---") = 0) Then
                count = count + 1
            Ende Wenn
        End If
            Exit Do ' Wenn eine Nicht-Tabellenzeile gefunden wird, wird die Schleife verlassen.
        End If
        currentIndex = currentIndex + 1 ' Zur nächsten Zeile gehen
    Schleife

    CountRows = Anzahl
Ende Funktion

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

    ' Berechnen der Anzahl der Zeilen und Spalten
    ' numRows = UBound(lines) - startIndex - 1 ' Kopf- und Trennzeilen subtrahieren
    numRows = CountRows(zeilen, startIndex)
    numColumns = CountColumns(lines(startIndex))

    ' Sicherstellen, dass die Anzahl der Zeilen und Spalten gültig ist
    Wenn numRows <= 0 Or numColumns <= 0 Then
        MsgBox "Ungültige Anzahl von Tabellenzeilen oder -spalten". , vbExclamation
        Exit Sub
    End If

    Set MyRange = ActiveDocument.Content
    MyRange.Collapse Direction:=wdCollapseEnd
    ' Eine Word-Tabelle erstellen
    Set table = ActiveDocument.Tables.Add(Range:=MyRange, numRows:=numRows + 1, numColumns:=numColumns) ' +1 für Tabellenkopf

    ' currentParagraph.InsertAfter table &amp; vbCrLf

    ' Tabellenkopf ausfüllen
    cellContent = Split(lines(startIndex), "|")
    For j = 1 To UBound(cellContent) - 1 ' Das erste | ignorieren, beginnend bei 1
        On Error Resume Next ' Parameterfehler ignorieren.
        table.Cell(1, j).Range.text = Trim(cellContent(j)) ' Die Tabellenüberschrift ausfüllen
        On Error GoTo 0 ' Ignorieren von Fehlern ausschalten.
    Weiter j

    ' Die Tabelle mit Daten füllen
    For i = startIndex + 2 To UBound(lines) ' Aus Datenzeilen auffüllen
        cellContent = Split(lines(i), "|")
        For j = 1 To UBound(cellContent) - 1 ' Bei 1 beginnen und das erste | ignorieren
            On Error Resume Next ' Parameterfehler ignorieren.
            table.Cell(i - startIndex, j).Range.text = Trim(cellContent(j)) ' Mit Daten füllen
            On Error GoTo 0 ' Ignorieren von Fehlern ausschalten.
        Nächste j
    Nächste i

    On Error Resume Next
    ' Tabellenränder auf 1 setzen
    With table.Borders
        .InsideLineStyle = wdLineStyleSingle
        .OutsideLineStyle = wdLineStyleSingle
        .InsideLineWidth = 1
        .OutsideLineWidth = 1
    Ende mit

End Sub

Kostenlose Verwendung des Bettler-Kopiloten in Word zur Unterstützung bei der Textfortsetzung

Empfohlen

Sie können keine AI-Tools finden? Versuchen Sie es hier!

FLUX.1 Bildgenerator (unterstützt chinesische Eingaben)

Neuerscheinungen

Beliebte Artikel

Heiße Tags.

Chef-KI-Austauschkreis