テキスト継続を支援するワード無料乞食コパイロット

DeepSeekのラグ？このサイトは無料です！全血DeepSeek-R1スムーズでネットワーク対応！無制限の使用！

コパイロット・メンバーシップやWPS AIメンバーシップを購入する余裕がなく、それでも文書内のテキストを継続的に表示したい場合は、マクロ・コードを使用すれば可能です。

MacOS用とWindows用の2種類があります：

このコンテンツは作者によって非表示にされています。コンテンツを表示するには認証コードを入力してください。

このサイトWeChat公開番号に注意してください、返信"CAPTCHA、チャレンジ・レスポンス・テストの一種（コンピューティング）"、認証コードを取得します。WeChatで"チーフAIシェアリングサークル「またはルックスAI"またはWeChatは、QRコードの右側をスキャンすると、このサイトWeChatの公開番号に注意を払うことができます。

1.APIキーを修正し、無料モデルに置き換えてください。

2.基本的な使い方は、まずテキストを選択してからAlt + F8マクロ操作を呼び出し チャットGPT準備はできている。

コアコード

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"

    APIキーを入力
    api_key = "open.bigmodel.cnでAPI KEYを取得してください"

    'モデル名
    モデル名 = "glm-4-plus"

    systemPrompt = "あなたはWORDに精通した親切なチャットボットです。 返信に説明を書かないでください。出力はマークダウンなしのマークダウン形式にしてください。"

    If api_key = "" Then
        MsgBox "エラー：APIキーが空白です！"
        終了 Sub
    End If

    ' ドキュメント内のテキストを選択するようユーザに促す
    If Selection.Type  wdSelectionIP Then
        prompt = Trim(Selection.text)
        Set selectedText = Selection.Range
    もしSelection.Type  wdSelectionIP ならば、 prompt = Trim(Selection.text) Set selectedText = Selection.Range.
        MsgBox "最初にコンテンツを選択してください！"
        終了 Sub
    End If

    'クリーニング
    text = Replace(prompt, Chr(34), Chr(39))
    text = Replace(text, vbLf, "")
    text = Replace(text, vbCr, "")
    text = Replace(text, vbCrLf, "")

    ' 選択範囲を削除する
    選択部分を折りたたむ

    ' HTTP 要求オブジェクトを作成する
    Set request = CreateObject("MSXML2.XMLHTTP")
    リクエスト
        .Open "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}""
            ステータスコード = .ステータス
            レスポンス = .レスポンステキスト
    End With
      'コンテンツを抽出する
    If status_code = 200 Then
      DisplayText = ExtractContent(response)

      '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)
        それ以外の場合
            DisplayText = ""
        End If

        エラーメッセージをWord文書に挿入する
        EDisplayText = "エラー : " & DisplayText
        selectedText.InsertAfter vbNewLine & EDisplayText

    End If


    'オブジェクトのクリーンアップ
    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>チャットボット紹介</title>\n</head>\n<body>\n<h1>こんにちは！</h1>\n<p>私はHTMLに精通した親切なチャットボットです。</p>\n</body>\n</html>", "role": "assistant"}}],""

    startPos = InStr(1, jsonString, """content"":""") + Len("""content"": """)
    endPos = InStr(startPos, jsonString, ",""役割"":"") - 2
    コンテンツ = Mid(jsonString, startPos, endPos - startPos)
    コンテンツ = Trim(Replace(Content, "\"", Chr(34)))

    コンテンツ = Replace(Content, vbCrLf, "")
    コンテンツ = Replace(Content, vbLf, "")
    内容 = 置換(内容, vbCr, "")
    内容 = 置換(内容, "♪n", vbCrLf)

    If Right(Content, 1) = """ Then
      コンテンツ = 左(コンテンツ, Len(Content) - 1)
    End If

    ExtractContent = コンテンツ

終了関数

関数 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テキストを行で分割
    lines = Split(markdownText, vbCr)

    On Error Resume Next
    ' 各行を繰り返し処理する
    For i = 0 To UBound(lines)
        lines = Trim(lines(i))

        ' 見出しを処理する
        If Left(line, 1) = "#" Then
            headerLevel = 0
            Do While Mid(line, headerLevel + 1, 1) = "#"
                ヘッダーレベル = ヘッダーレベル + 1
            ループ
            ' ヘッダー段落を作成する
            Set currentParagraph = ActiveDocument.Content
            現在の段落の折りたたみ方向：=wdCollapseEnd
            currentParagraph.InsertAfter Trim(Replace(line, "#", "")) &amp; vbCrLf
            currentParagraph.Style = ActiveDocument.Styles("Header " &amp; headerLevel)

        ' 太字を処理する
        ElseIf InStr(line, "**") &gt; 0 Then
            line = Replace(line, "**", "")
            Set currentParagraph = ActiveDocument.Content
            currentParagraph.Collapse Direction:=wdCollapseEnd
            currentParagraph.InsertAfter line &amp; vbCrLf
            currentParagraph.Font.Bold = True

        ' イタリック体の処理
        ElseIf InStr(line, "*") &gt; 0 Then
            line = Replace(line, "*", "")
            Set currentParagraph = ActiveDocument.Content
            currentParagraph.Collapse Direction:=wdCollapseEnd
            currentParagraph.InsertAfter line &amp; 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)) &amp; vbCrLf ' 前の記号を削除します。
            currentParagraph.ListFormat.ApplyBulletDefault

        ' 順序付きリストの処理
        ElseIf IsOrderedList(line) Then
            Set currentParagraph = ActiveDocument.Content
            currentParagraph.Collapseの方向：=wdCollapseEnd
            currentParagraph.InsertAfter Trim(line) &amp; vbCrLf
            currentParagraph.ListFormat.ApplyNumberDefault

        ' リンクの処理
        ElseIf InStr(line, "[") &gt; 0 And InStr(line, "]") &gt; 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
            linkText &amp; vbCrLfの後にcurrentParagraph.InsertAfterを挿入します。
            ActiveDocument.Hyperlinks.Add Anchor:=currentParagraph, Address:=linkURL, TextToDisplay:=linkText

        ' テーブルの処理
        ElseIf IsMarkdownTable(lines, i) Then
            ' テーブルの処理
            ConvertMarkdownToTable lines, i
            ' テーブルの行をスキップする
            i = i + CountRows(lines, i) + 1 ' テーブルのヘッダーと区切り行をスキップする
        ' 通常の段落を処理する
        その他
            セット currentParagraph = ActiveDocument.Content
            currentParagraph.Collapse Direction:=wdCollapseEnd
            currentParagraph.InsertAfter line &amp; vbCrLf
        End If
    End If
関数終了

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

    ' 数字で始まり、ドットが続くかどうかをチェックする
    If UBound(parts) &gt; 0 Then
        If IsNumeric(Trim(parts(0))) And Len(Trim(parts(0))) &gt; 0 Then
            IsOrderedList = True
            関数終了
        End If
    End If

    IsOrderedList = False
関数終了

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

    ' 少なくとも3行（ヘッダ、セパレータ、および少なくとも1行のデータ）があることをチェックする
    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
        関数終了
    End If

    separatorLine = Trim(lines(startIndex + 1))

    IsMarkdownTable = True
終了関数

関数 CountColumns(headerLine As String) As Long
    ' カラムの数を数え、最初と最後を削除する。
    Dim columns() As String
    columns = Split(headerLine, "|")
    CountColumns = UBound(columns) - 1 ' 最初と最後のものを差し引く
関数終了

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

    ' startIndex + 2から開始し、ヘッダ行とセパレータ行をスキップする。
    Dim currentIndex As Long
    currentIndex = startIndex + 2 ' ヘッダー行とセパレーター行をスキップします。

    ' 境界を超えるまでチェックを続ける
    Do While currentIndex <= UBound(lines)
        ' 检查当前行是否为数据行，忽略分隔行
        If Trim(lines(currentIndex) <> "") And InStr(lines(currentIndex), "|") &gt; 0 Then
            ' 行の区切り文字を無視する
            If Trim(InStr(lines(currentIndex), "|---") = 0) Then
                count = count + 1
            End If
        End If
            Exit Do ' テーブル行でない行に遭遇したら、ループを抜ける。
        End If
        currentIndex = currentIndex + 1 ' 次の行に移動する。
    ループ

    CountRows = count
関数終了

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))

    ' 行数と列数が有効であることを確認する
    もし numRows <= 0 Or numColumns <= 0 Then
        'MsgBox "テーブルの行数または列数が無効です。", vbExclamation
        終了
    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 &amp; 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 ' エラー無視をオフにする。
    次の 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 ' エラー無視をオフにする。
        次の j
    次の i

    On Error Resume Next
    ' テーブルの境界線を1に設定する
    With table.Borders
        .InsideLineStyle = wdLineStyleSingle
        .OutsideLineStyle = wdLineStyleSingle
        .InsideLineWidth = 1
        .OutsideLineWidth = 1
    End With

End Sub

ワードの乞食コパイロットを無料で使用し、テキストの継続を支援する。

おすすめ

AIツールが見つからない？こちらをお試しください！

FLUX.1イメージジェネレーター（中国語入力対応）

新着情報

人気記事

ホットタグ

チーフAIシェアリングサークル