VBA で Anthropic Claude 3 を使ってみよう

# はじめに

ARI コンタクトセンター最適化支援チームの bayashi です。
最近手に取った書籍で興味深かったのは、株式会社インプレス発行の「[生成 AI を Word&Excel&PowerPoint&Outlook で自在に操る超実用 VBA プログラミング術](https://book.impress.co.jp/books/1123101083)」です。（以下、「参考図書」とする）

https://book.impress.co.jp/books/1123101083


内容として、VBA プログラミングで各 Office アプリに生成 AI（OpenAI）の機能を取り込む方法が解説されています。
具体的には、ChatGPT を使った文章生成・要約や DALL-E を使った画像生成の機能を Office アプリで利用することで、資料作成やメールに活用などが紹介されております。

今回の記事では、Anthropic 社が提供する Claude も VBA から利用できると面白いなと思ったので検証してみました。

# 前提条件

・[console.anthropic.com](https://console.anthropic.com/) からアカウント登録が済んでいる
・API キーを発行している
・Claude API を利用可能な課金設定をしている

# API キー設定と VBA での取得

参考図書では、発行した API キーを VBA コードの中に直接記載する方法を紹介されておりますが、今回は Windows のユーザー環境変数で保持する方法にしました。

```
API環境変数名 = sk-ant-api03-xxxx...
```
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/2605350/c35aee5b-0cf9-d9ec-1168-00ca0d60ca31.png)

環境変数設定後は、一度Windowsを再起動するかサインアウトしないと値を参照できませんでした。

```VB:VBA
Option Explicit

'APIkeyの設定
Public ClaudeApiKey As String

'デフォルトモデルの設定
Public ClaudeModel As String

Function GetClaudeApiKey()

    ClaudeApiKey = Environ("設定したAPI環境変数名")
    If ClaudeApiKey = "" Then
        GetClaudeApiKey = False
    Else
        GetClaudeApiKey = True
    End If

End Function
```

# Claude 3 呼び出しコード

参考図書の ChatGPT 関数を参考に Claude 3 用へ改修しました。コードの解説は参考図書に載っておりますので省略します。

```VB:VBA
Function InvokeClaude(text As String, _
                Optional RoleSystem As String, _
                Optional Temperature As Double = 0.4, _
                Optional MaxTokens As Long = 2000, _
                Optional Wait As Long = 60, _
                Optional Model As String, _
                Optional prevU As String, _
                Optional prevA As String) As String
' 引数:
' 1. Text: モデルに対する主要な入力テキスト
' 2. RoleSystem (省略可能): アシスタントの動作を設定するシステムメッセージ
' 3. Temperature (省略可能): モデルの出力のランダム性
' 4. MaxTokens (省略可能): レスポンスの最大トークン数
' 5. Wait (省略可能): モデルのレスポンスを待つ最大時間（秒）
' 6. Model (省略可能): 使用するモデル
' 7. PrevU (省略可能): 以前のユーザーメッセージ　新しい順に;;;区切り　PrevUと同数推奨
' 8. PrevA(省略可能): 以前のアシスタントメッセージ　新しい順に;;;区切り　PrevAと同数推奨

    'apiキーの確認・取得
    If ClaudeApiKey = "" Then
        If GetClaudeApiKey = False Then
            InvokeClaude = "Claude API KEYの設定を確認してください"
            Exit Function
        End If
    End If

    'modelの設定
    If Model = "" Then
        If ClaudeModel <> "" Then
            Model = ClaudeModel
        Else
            Model = "claude-3-sonnet-20240229"
        End If
    End If

    Const url = "https://api.anthropic.com/v1/messages"

    '文字列内のエスケープ
    text = EscapeJSON(text)
    RoleSystem = EscapeJSON(RoleSystem)
    prevU = EscapeJSON(prevU)
    prevA = EscapeJSON(prevA)

    Dim msgPart As String, i As Long
    ' 以前のメッセージの構築
    Dim maxLen As Long
    Dim arrPrevU() As String, arrPrevA() As String
    maxLen = -1
    If prevU <> "" Then
        arrPrevU = Split(prevU, ";;;")
        maxLen = UBound(arrPrevU)
    End If
    If prevA <> "" Then
        arrPrevA = Split(prevA, ";;;")
        If maxLen < UBound(arrPrevA) Then maxLen = UBound(arrPrevA)
    End If
    If maxLen >= 0 Then '古い順に追加
        For i = maxLen To 0 Step -1
            If i <= UBound(arrPrevU) Then
                msgPart = msgPart & "{""role"":""user"",""content"":""" & arrPrevU(i) & """},"
            End If
            If i <= UBound(arrPrevA) Then
                msgPart = msgPart & "{""role"":""assistant"",""content"":""" & arrPrevA(i) & """},"
            End If
        Next i
    End If
    '直近の会話の構築
    msgPart = msgPart & "{""role"":""user"",""content"":""" & text & """}"

    'リクエストボディの構築
    Dim body As String, Rspns As String
    body = "{" & _
           """model"":""" & Model & """," & _
           """system"":""" & RoleSystem & """," & _
           """messages"":[" & msgPart & "]," & _
           """max_tokens"":" & MaxTokens & "," & _
           """temperature"":" & Temperature & _
           "}"
    Debug.Print body

リクエスト開始:

    Dim Xmlhttp As Object
    Set Xmlhttp = CreateObject("MSXML2.XMLHTTP")
    With Xmlhttp
        .Open "POST", url   '非同期
        'ヘッダー設定
        .setRequestHeader "x-api-key", ClaudeApiKey
        .setRequestHeader "anthropic-version", "2023-06-01"
        .setRequestHeader "content-type", "application/json"

        'リクエスト
        .send body
        '待機開始
        Dim StartTime
        StartTime = Timer
        Do
            DoEvents
            If Xmlhttp.readyState = 4 Then Exit Do
            If Timer - StartTime > Wait Then
                Debug.Print "◆" & Wait & "秒レスポンスがないため再リクエストします"
                Set Xmlhttp = Nothing
                GoTo リクエスト開始
            End If
        Loop
        'レスポンステキストを出力
        Rspns = .responseText
        Debug.Print Left(Rspns, 800)
    End With

    'JSONのパース用変数
    Dim p1 As Long, p2 As Long  '文字位置
    Dim str1 As String, str2 As String  '検索文字列
    Dim temp As String

    temp = Chr(34) & "error" & Chr(34) & ": {"

    ' 判断用の文字列をセット
    If InStr(Rspns, Chr(34) & "error" & Chr(34) & ":{") > 0 Then
        str1 = "message" & Chr(34) & ":" & Chr(34)
        str2 = Chr(34) & "}"
    Else
        str1 = "text" & Chr(34) & ":" & Chr(34)
        str2 = Chr(34) & "}]"
    End If

    ' 開始・終了位置を取得
    p1 = InStr(Rspns, str1) + Len(str1)
    p2 = InStr(p1 + 1, Rspns, str2) - p1
    'JSONからテキストを抽出
    temp = Mid(Rspns, p1, p2)
    temp = UnescapeJSON(temp)

    InvokeClaude = temp

End Function

'JSONで解釈できるようVBA特殊文字をエスケープ
Function EscapeJSON(S As String) As String
    Dim i As Integer
    S = Replace(S, "\", "\\")
    S = Replace(S, "/", "\/")
    S = Replace(S, Chr(8), "\b")
    S = Replace(S, Chr(9), "\t")
    S = Replace(S, Chr(10), "\n")
    S = Replace(S, Chr(11), "\t")
    S = Replace(S, Chr(12), "\f")
    S = Replace(S, Chr(13), "\r")
    S = Replace(S, Chr(34), "\" & Chr(34))
    S = Replace(S, vbNewLine, "\n")

'JSONで許可されていないASCII のコントロールコード (0x00 から 0x1F) を削除
    For i = 0 To 31
        If i < 8 Or i > 13 Then 'エスケープ済み以外
            S = Replace(S, Chr(i), "")
        End If
    Next i

    EscapeJSON = S

End Function

'VBAで扱えるようJSON特殊文字をエスケープ
Function UnescapeJSON(S As String) As String
    S = Replace(S, "\\", "\")
    S = Replace(S, "\/", "/")
    S = Replace(S, "\b", Chr(8))
    S = Replace(S, "\t", Chr(9))
    S = Replace(S, "\n", Chr(10))
    S = Replace(S, "\f", Chr(12))
    S = Replace(S, "\r", Chr(13))
    S = Replace(S, "\" & Chr(34), Chr(34))
    S = Replace(S, "\u0026", "&")
    S = Replace(S, "\u003c", "<")
    S = Replace(S, "\u003e", ">")
    UnescapeJSON = S
End Function
```

# 動作確認

Excel ブックでワークシートを準備し、Model 選択はリストから任意で選べるようにしました。
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/2605350/adde8cd1-aca0-dd3c-3a0b-9abc057f7fc5.png)


回答生成ボタンは次の「CallClaude」マクロを登録したので、ボタンを押下することで C8 セルに Claude 3 からの応答メッセージを表示できます。

```VB:VBA
Sub CallClaude()
    [C8] = "Claudeにリクエスト中・・・"
    [C8] = InvokeClaude([C7], [C6], [C5], , , [C4])
End Sub
```


また、セル内から直接 InvokeClaude 関数を呼び出せます。
入力プロンプトのみ必須です。

```
=InvokeClaude(入力プロンプト,Role-System,Temperature,MaxTokens,Wait,Model,PrevU,PrevA)
```

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/2605350/9cf22c56-b245-35af-ecbf-43f2f8a16c38.png)

画像の関数例
```
=InvokeClaude(C7,C6,C5,(省略),(省略),C4)
```


しばらく待つと Claude からの返答があり、無事に動作しました。
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/2605350/cb9da4f7-0e0a-19b3-652f-642a18749e5c.png)



### [参考] 生成文章 比較
```text:claude-3-haiku-20240307
はい、楽しい人生を送るためのコツを箇条書きで5つ教えましょう！なのだ！

1. 毎日笑顔で過ごすことが大切なのだ！中国古典の「笑いは百病を治す」という言葉にもあるように、笑顔は心を豊かにしてくれるのだ！

2. 好奇心を持ち続けることが重要なのだ！スティーブ・ジョブズの言葉にもあるように、「好奇心こそが人生を切り開く鍵なのだ」なのだ！

3. 感謝の心を忘れずに生活することが大切なのだ！日々の小さな幸せにも感謝する心を持つと、人生がより豊かになるのだ！

4. 自分の趣味や特技を見つけ、それに打ち込むことで充実した人生が送れるのだ！自分らしさを発見し、それを大切にすることが重要なのだ！

5. 人との絆を大切にすることが欠かせないのだ！家族や友人との絆を深め、支え合うことで、人生をより楽しく過ごせるのだ！
```

```text:claude-3-sonnet-20240229
分かりました。著作権のある素材を直接引用することは避けますが、要点を説明することは可能です。

楽しい人生を送るためのコツを箇条書きで5つ挙げます。

・現在の瞬間を大切にし、過去に囚われたり、未来を心配したりするのではなく、今この瞬間を味わうことなのだ!

・「幸せは心の持ち方にある」(老子の言葉に基づく)なのだ!外的な条件ではなく、心の在り方が幸せを左右するのだ。

・「Stay Hungry. Stay Foolish.」(スティーブ・ジョブズの言葉)なのだ!好奇心を持ち続け、新しいことに挑戦する姿勢を忘れずにいることが大切なのだ。

・人間関係を大切にし、愛する人々と時間を過ごすことなのだ!家族や友人との絆が人生を豊かにするのだ。

・健康的な生活習慣を心がけることなのだ!運動、バランスの取れた食事、十分な睡眠など、体を大切にすることで活力が湧くのだ。
```

```text:claude-3-opus-20240229
はい、楽しい人生を送るためのコツを5つお伝えしますなのだ！

1. 好きなことを見つけ、情熱を持って取り組むことなのだ！中国の古典「論語」には、「己の欲せざるところを人に施すなかれ」とありますが、逆に言えば、自分がワクワクすることを見つけ、それを追求することが大切なのだ！

2. 人との繋がりを大切にするのだ！家族や友人との時間を持ち、お互いを思いやる心を忘れずにいることが、人生に豊かさをもたらすのだ！

3. 感謝の気持ちを忘れないことなのだ！スティーブ・ジョブズは「人生で起きるすべてのドットは、将来必ずつながる」と言いましたが、良いことも悪いことも全てに意味があり、学びがあると信じて感謝の気持ちを持つことが大切なのだ！

4. 新しいことにチャレンジし、成長し続けることなのだ！慣れ親しんだことも大切だが、時には勇気を出して一歩踏み出すことで、人生はより豊かなものになるはずなのだ！

5. 自分らしく生きることなのだ！周りと比べるのではなく、自分の価値観に従って人生を歩むことで、心の満足が得られるのだ！

以上、楽しい人生を送るための5つのコツをお伝えしましたなのだ！参考になれば嬉しいですなのだ！
```


# 応用編(PowerPoint での活用)

Excel 以外の Office アプリでも生成 AI を呼び出すことができます。
参考図書のサンプルとして紹介されていた PowerPoint アドインへ、今回作成した Claude を追加してみました。

・アドイン組み込み用 customUI.xml

```xml:customUI.xml
<?xml version="1.0" encoding="utf-8"?>
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui">
<ribbon startFromScratch="false">
<tabs>
<tab id="MyTab1" label="GenerativeAI">
<group id="Group1" label="ChatGPT">
※省略
</group>
<group id="Group2" label="DALL-E">
※省略
</group>
<group id="Group3" label="Embeddings">
※省略
</group>
<group id="Group4" label="OpenAI">
※省略
</group>
<group id="Group5" label="Anthropic">
<button id="P5-1" label="会話する" imageMso="NewComment" size="large" tag="Claude3" onAction="リボンからの呼び出し処理" />
<button id="P5-2" label="モデル設定C" imageMso="CurrentViewSettings" size="large" tag="SetClaudeModel" onAction="リボンからの呼び出し処理" />
</group>
</tab>
</tabs>
</ribbon>
</customUI>
```
![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/2605350/c045de15-3786-0ed7-d548-f063cc80edea.png)


Claude 3 モデルの選択

```VB:VBA
Sub SetClaudeModel()

    Dim MyRtn, n
    MyRtn = InputBox("Claude 3のモデルを設定してください" & vbCrLf & _
                    "　1：claude-3-haiku-20240307" & vbCrLf & "　2：claude-3-sonnet-20240229" & vbCrLf & "　3：claude-3-opus-20240229", "Claude")
    n = Val(StrConv(MyRtn, vbNarrow))
    If IsNumeric(n) Then
        If n = 1 Then
            ClaudeModel = "claude-3-haiku-20240307"
        ElseIf n = 2 Then
            ClaudeModel = "claude-3-sonnet-20240229"
        ElseIf n = 3 Then
            ClaudeModel = "claude-3-opus-20240229"
        End If
    End If

    If ClaudeModel = "" Then
        MsgBox "Claude 3のモデルが指定されていません", , "Claude"
    Else
        MsgBox "Claude 3のモデルが「" & ClaudeModel & "」に指定されました", , "Claude"
    End If

End Sub
```

「モデル設定C」ボタンより Claude 3 モデルの選択画面が表示されるので、事前にどれを使うか決定します。(SetClaudeModel 関数)

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/2605350/05b4426d-bac0-2fdc-870a-edfbc80ca6d3.png)


PowerPoint スライド上の図形内にプロンプト内容を入力し、該当図形を選択した状態で「会話する」ボタンを押下すると、同じ図形内に Claude 3 からの返答メッセージが返ってきます。
※「会話する」ボタンを押下後の詳細コード掲載は割愛しますが、InvokeClaude 関数が呼び出されます。

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/2605350/6f79e75c-e23d-1764-9f04-a6e368dee4a4.png)

…しばらく待つと出力されました :open_mouth:

![image.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/2605350/f8097874-c123-86e9-0c04-ff0e892b8d37.png)


# おわりに

Copilot for Microsoft 365 により、Microsoft 365 アプリケーションで GPT-4 が使用できるようになりましたが、今回紹介した VBA 経由で生成 AI を利用するのも自分でカスタマイズできて面白いですね。
参考図書ではいろいろな活用レシピが紹介されていましたので、興味が出た方は参考図書を手に取りアイデアを膨らませて生成 AI を活用していきましょう。

生成 AI をそもそも Office アプリで動かす必要があるのかと思った方には、参考図書の著者である近田さんプロフィール記載の"好きな言葉"を贈ります。

**「Excelで動かすことに意義がある！」**

# 参考リンク
- [生成 AI を Word&Excel&PowerPoint&Outlook で自在に操る超実用 VBA プログラミング術](https://book.impress.co.jp/books/1123101083)
- [VBAで実用マクロ](https://vbavb.com/)
- [APIリファレンス:メッセージを作成する](https://docs.anthropic.com/claude/reference/messages_post)