はじめに
ARI コンタクトセンター最適化支援チームの bayashi です。
最近手に取った書籍で興味深かったのは、株式会社インプレス発行の「生成 AI を Word&Excel&PowerPoint&Outlook で自在に操る超実用 VBA プログラミング術」です。（以下、「参考図書」とする）
内容として、VBA プログラミングで各 Office アプリに生成 AI（OpenAI）の機能を取り込む方法が解説されています。
具体的には、ChatGPT を使った文章生成・要約や DALL-E を使った画像生成の機能を Office アプリで利用することで、資料作成やメールに活用などが紹介されております。
今回の記事では、Anthropic 社が提供する Claude も VBA から利用できると面白いなと思ったので検証してみました。
前提条件
・console.anthropic.com からアカウント登録が済んでいる
・API キーを発行している
・Claude API を利用可能な課金設定をしている
API キー設定と VBA での取得
参考図書では、発行した API キーを VBA コードの中に直接記載する方法を紹介されておりますが、今回は Windows のユーザー環境変数で保持する方法にしました。
API環境変数名 = sk-ant-api03-xxxx...
環境変数設定後は、一度Windowsを再起動するかサインアウトしないと値を参照できませんでした。
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 用へ改修しました。コードの解説は参考図書に載っておりますので省略します。
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 選択はリストから任意で選べるようにしました。
回答生成ボタンは次の「CallClaude」マクロを登録したので、ボタンを押下することで C8 セルに Claude 3 からの応答メッセージを表示できます。
VBA
Sub CallClaude()
[C8] = "Claudeにリクエスト中・・・"
[C8] = InvokeClaude([C7], [C6], [C5], , , [C4])
End Sub
また、セル内から直接 InvokeClaude 関数を呼び出せます。
入力プロンプトのみ必須です。
=InvokeClaude(入力プロンプト,Role-System,Temperature,MaxTokens,Wait,Model,PrevU,PrevA)
画像の関数例
=InvokeClaude(C7,C6,C5,(省略),(省略),C4)
しばらく待つと Claude からの返答があり、無事に動作しました。
[参考] 生成文章 比較
claude-3-haiku-20240307
はい、楽しい人生を送るためのコツを箇条書きで5つ教えましょう！なのだ！
1. 毎日笑顔で過ごすことが大切なのだ！中国古典の「笑いは百病を治す」という言葉にもあるように、笑顔は心を豊かにしてくれるのだ！
2. 好奇心を持ち続けることが重要なのだ！スティーブ・ジョブズの言葉にもあるように、「好奇心こそが人生を切り開く鍵なのだ」なのだ！
3. 感謝の心を忘れずに生活することが大切なのだ！日々の小さな幸せにも感謝する心を持つと、人生がより豊かになるのだ！
4. 自分の趣味や特技を見つけ、それに打ち込むことで充実した人生が送れるのだ！自分らしさを発見し、それを大切にすることが重要なのだ！
5. 人との絆を大切にすることが欠かせないのだ！家族や友人との絆を深め、支え合うことで、人生をより楽しく過ごせるのだ！
claude-3-sonnet-20240229
分かりました。著作権のある素材を直接引用することは避けますが、要点を説明することは可能です。
楽しい人生を送るためのコツを箇条書きで5つ挙げます。
・現在の瞬間を大切にし、過去に囚われたり、未来を心配したりするのではなく、今この瞬間を味わうことなのだ!
・「幸せは心の持ち方にある」(老子の言葉に基づく)なのだ!外的な条件ではなく、心の在り方が幸せを左右するのだ。
・「Stay Hungry. Stay Foolish.」(スティーブ・ジョブズの言葉)なのだ!好奇心を持ち続け、新しいことに挑戦する姿勢を忘れずにいることが大切なのだ。
・人間関係を大切にし、愛する人々と時間を過ごすことなのだ!家族や友人との絆が人生を豊かにするのだ。
・健康的な生活習慣を心がけることなのだ!運動、バランスの取れた食事、十分な睡眠など、体を大切にすることで活力が湧くのだ。
claude-3-opus-20240229
はい、楽しい人生を送るためのコツを5つお伝えしますなのだ！
1. 好きなことを見つけ、情熱を持って取り組むことなのだ！中国の古典「論語」には、「己の欲せざるところを人に施すなかれ」とありますが、逆に言えば、自分がワクワクすることを見つけ、それを追求することが大切なのだ！
2. 人との繋がりを大切にするのだ！家族や友人との時間を持ち、お互いを思いやる心を忘れずにいることが、人生に豊かさをもたらすのだ！
3. 感謝の気持ちを忘れないことなのだ！スティーブ・ジョブズは「人生で起きるすべてのドットは、将来必ずつながる」と言いましたが、良いことも悪いことも全てに意味があり、学びがあると信じて感謝の気持ちを持つことが大切なのだ！
4. 新しいことにチャレンジし、成長し続けることなのだ！慣れ親しんだことも大切だが、時には勇気を出して一歩踏み出すことで、人生はより豊かなものになるはずなのだ！
5. 自分らしく生きることなのだ！周りと比べるのではなく、自分の価値観に従って人生を歩むことで、心の満足が得られるのだ！
以上、楽しい人生を送るための5つのコツをお伝えしましたなのだ！参考になれば嬉しいですなのだ！
応用編(PowerPoint での活用)
Excel 以外の Office アプリでも生成 AI を呼び出すことができます。
参考図書のサンプルとして紹介されていた PowerPoint アドインへ、今回作成した Claude を追加してみました。
・アドイン組み込み用 customUI.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>
Claude 3 モデルの選択
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 関数)
PowerPoint スライド上の図形内にプロンプト内容を入力し、該当図形を選択した状態で「会話する」ボタンを押下すると、同じ図形内に Claude 3 からの返答メッセージが返ってきます。
※「会話する」ボタンを押下後の詳細コード掲載は割愛しますが、InvokeClaude 関数が呼び出されます。
…しばらく待つと出力されました 
おわりに
Copilot for Microsoft 365 により、Microsoft 365 アプリケーションで GPT-4 が使用できるようになりましたが、今回紹介した VBA 経由で生成 AI を利用するのも自分でカスタマイズできて面白いですね。
参考図書ではいろいろな活用レシピが紹介されていましたので、興味が出た方は参考図書を手に取りアイデアを膨らませて生成 AI を活用していきましょう。
生成 AI をそもそも Office アプリで動かす必要があるのかと思った方には、参考図書の著者である近田さんプロフィール記載の"好きな言葉"を贈ります。
「Excelで動かすことに意義がある！」