AIのAPIを使用したExcel VBA処理について

投稿者 : kaname WD     投稿日時 : 2025/04/01(Tue) 10:19:41     OS : Windows 11     EXCEL : Office 365

---

大量のExcelがあり、それらを1つずつ開いては、特定領域の文章を要約して、シートに抽出することを想定しています。
AI(Gemini API)を使用して、セルの内容を要約するVBAマクロを組めるのか模索中です。
JSONでやりとりするアイデアだけは見つかったのですが、
実際に上記の要件を満たす動作が可能なのか分からず。
似たようなことを実現された方が居られるかを聞きたいです。

AIに聞いてみて組んでみましたが、JSONを作成しようとしてもemptyになってしまいました。
あまり世に実績のないマクロを組んでもらってるので信憑性を感じられず。

投稿者 : ごんぼほり     投稿日時 : 2025/04/02(Wed) 12:16:13

---

雰囲気だけよみとってください

参考にしたサイト
https://qiita.com/futayubi5656/items/faf419ad0331c39639fc
https://qiita.com/KakeiAkihiko/items/f936e4605aa343fcef0d

Sub test()
    MsgBox ASKGemini("桜の名所のおすすめを3カ所列挙してください。")
End Sub

Function ASKGemini(prompt As String) As String
    cmd = "$Prompt = '" & prompt & "' ;" _
        & "$uri     = 'https://generativelanguage.googleapis.com/v1beta/models/gemini-1.5-pro:generateContent';" _
        & "$API_KEY = 'YOUR=API-KEY';" _
        & "$body = @{" _
        & "    contents = @(" _
        & "        @{" _
        & "            role = 'user';" _
        & "            parts = @(" _
        & "                @{" _
        & "                    text = $Prompt" _
        & "                }" _
        & "            )" _
        & "        }" _
        & "    )" _
        & "} | ConvertTo-Json -Depth 4;" _
        & "$QueryParam = @{" _
        & "    Method      = 'Post';" _
        & "    uri         = $uri;" _
        & "    Headers     = @{'x-goog-api-key'=$API_KEY};" _
        & "    ContentType = 'application/json';" _
        & "    Body        = [Text.Encoding]::UTF8.GetBytes($body)" _
        & "};" _
        & "$WebResponse  = Invoke-WebRequest @QueryParam;" _
        & "$response = $WebResponse.Content | ConvertFrom-Json;" _
        & "$response.candidates.content.parts.text"

   With CreateObject("WScript.Shell")
       ret = .Exec("powershell -NoLogo -ExecutionPolicy RemoteSigned -Command " & cmd).StdOut.ReadAll
   End With
   ASKGemini = ret
End Function

投稿者 : ごんぼほり     投稿日時 : 2025/04/03(Thu) 12:47:17

---

そのものズバリでないとダメですかそうですか回答に対するレスポンスがないってほんとひどいと思いませんか？

Property プロシジャも枠で囲ってほしいです

' --------------------- class モジュール clsGemini ------------------
' 参照設定
'    MicroSoft Scripting Rumtime
'    Microsoft XML v6.0
'
' JsonConverter.bas をVBAプロジェクトにインポート
' 　https://github.com/VBA-tools/VBA-JSON/blob/master/JsonConverter.bas
'
Private Const mURI As String = "https://generativelanguage.googleapis.com/v1beta/models/gemini-1.5-pro:generateContent"
Private mAPIKEY As String
Private mobjHTTPXML As MSXML2.XMLHTTP60
Private Sub Class_Initialize()
   Set mobjHTTPXML = CreateObject("MSXML2.XMLHTTP.6.0")
End Sub
Private Sub Class_Terminate()
   Set mobjHTTPXML = Nothing
End Sub
Public Function ASK(prompt As String) As String
   Dim requestBody As String
   Dim domdoc As MSXML2.DOMDocument60
   requestBody = "{""contents"": [{""parts"":[{""text"": """ + prompt + """}]}]}"
   mobjHTTPXML.Open "POST", mURI, False
   mobjHTTPXML.setRequestHeader "Content-Type", "application/json"
   mobjHTTPXML.setRequestHeader "x-goog-api-key", mAPIKEY
   mobjHTTPXML.send requestBody
   Do While mobjHTTPXML.readyState < 4
      DoEvents
   Loop
   If mobjHTTPXML.statusText = "OK" Then
     ASK = GetValueFromJSON("\candidates\content\parts\text", mobjHTTPXML.responseText)
   Else
     ASK = ""
   End If
End Function

Public Property Let APIKEY(ByVal vNewValue As String)
mAPIKEY = vNewValue
End Property
Public Property Get APIKEY() As String
APIKEY = mAPIKEY
End Property

Private Function GetValueFromJSON(ByVal target As String, ByVal JSON As Variant, Optional ByVal tree As String = "")
   If TypeName(JSON) = "String" Then
      Set dic = JsonConverter.ParseJson(JSON)
   ElseIf TypeName(JSON) = "Dictionary" Then
      Set dic = JSON
   Else
      Exit Function
   End If
   For Each Key In dic.Keys
      Select Case TypeName(dic(Key))
          Case "Collection"
             For Each p In dic(Key)
                Select Case TypeName(p)
                   Case "Dictionary"
                      ret = ret & GetValueFromJSON(target, p, tree & "\" & Key)
                   Case Else
                      If tree & "\" & Key = target Then
                         ret = ret & dic(Key)
                      End If
                End Select
             Next
          Case "Dictionary"
             ret = ret & GetValueFromJSON(target, dic(Key), tree & "\" & Key)
          Case Else
             If tree & "\" & Key = target Then
                ret = ret & dic(Key)
             End If
      End Select
   Next
   GetValueFromJSON = ret
End Function

'------------------  標準モジュール ---------------------------------
Sub sample()
   Dim Gemini As clsGemini
   Dim prompt As String, ret As String
   
   Set Gemini = New clsGemini
   Gemini.APIKEY = "APIKEYをここで指定"
   
   prompt = "日本の桜の名所を3カ所教えてください。"
   ret = Gemini.ASK(prompt)
   MsgBox prompt & vbLf & vbLf & ret
   prompt = "お花見で食べるものをおすすめしてください。"
   ret = Gemini.ASK(prompt)
   MsgBox prompt & vbLf & vbLf & ret
End Sub

投稿者 : kaname WD     投稿日時 : 2025/04/09(Wed) 12:27:57

---

ごんぼほり様

ご丁寧な回答ありがとうございます。リアクション遅くなり申し訳ありません。
APIキー設定して動作を確認しました。実際に動作しており感動しました。
あとは自身の要件に合わせてどう実装するかを前向きに検討できそうです。