SeleniumVBAによるCopilot返答を取得、シートに転記するするマクロです。以前Google翻訳をSeleniumで実施https://gakuhenn.com/seleniumvba-translate/しましたが、今回はCopilot返答を取得し、纏めや文末合わせ等の翻訳に限らない柔軟な戻り値を取得できます。
ブラウザでのCopilotURLを使用するため、Microsoftt365 Copilotプランに加入している必要があります。
ちなみにSeleniumVBAGoogle翻訳はMS公式のTranslate関数により沈められました。さらに、公式によりCopilot関数の正式導入が間もなくあるそうで、今回のマクロも公式に潰される未来が見えますが正式導入より早く発表させることで何とか今マクロの意義を作りたいです。What's New in Excel (June 2025) | Microsoft Community Hub
挙動
①UF上での回答取得と②セル範囲による回答取得との2種類があります。
①UF上での回答取得
UF上で入力した質問に対して、Copilot返答がUF上に表示されます。質問はセル範囲選択でも入力可能です。
続けて送信を押すと、現在開いているインスタンスを再利用して同じチャット内のやり取りができます。質問テキストボックスには、直接テキスト入力だけでなく、選択したセル値を質問とすることができます。
②セル範囲による回答取得
選択したブックのセル範囲それぞれとプロンプトをインプットとしてCopilotに投げかけ、それぞれの返答を取得します。
返答した取得は選択したセル右列に転記されます。また、プロンプトの内容は右上に表示され、どんなプロンプトに対する返答か把握できます。
実行中は状況がステータスバーに表示されます。大体フローを5分割し、フローごとに配置した簡素な分割のため、完全な進捗状況は荒はしていませんが、実行中であることを確認できます。
コード
・SeleniumVBAのダウンロード：Releases · GCuser99/SeleniumVBA
・SeleniumVBAのダウンロードからの手順：[Excel VBA]WebDriver経由でブラウザ操作（SeleniumVBA使い方メモ） #ExcelVBA - Qiita
SeleniumVBAをダウンロードし、標準プロシージャとUFを作成し、下記2コードを貼り付けてください。
➤コードはこちら
Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function SetForegroundWindow Lib "user32" ( _
ByVal hwnd As LongPtr) As Long
#Else
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetForegroundWindow Lib "user32" ( _
ByVal hwnd As Long) As Long
#End If
Public RequestType As String '簡易取得返答か、複数セル質問か判断処理用
Private driver As SeleniumVBA.WebDriver, WebKey As New WebKeyboard, CpilotTargetBox As Object 'コパイロットに送るボックス用
Private statuscnt As Long, statuscntfori As Long
'Private
Function UFpCopilot(Optional Inputrng As Range, Optional InputQ As Variant) As String '2508 UF要subテスト
If RequestType = "簡易質問" Then
If InputQ = "" Then
MsgBox "Error:質問を入力してください"
Exit Function
End If
ElseIf RequestType = "セル質問" Then
Dim transrng As Range, rng As Range
On Error Resume Next
If Inputrng Is Nothing Then
'Set Inputrng = Application.InputBox("セルを選択してください", , , , , , , 8)
'If Inputrng Is Nothing Then
MsgBox "Error:セルを選択してください"
Exit Function
On Error GoTo 0
End If
On Error Resume Next
If IsMissing(InputQ) Then
'Set InputQorNo = Application.InputBox("質問を入力してください", , , , , , , 2)
'If Inputrng Is Nothing Then
MsgBox "Error:質問かテンプレ質問Noを入力してください"
Exit Function
On Error GoTo 0
End If
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''エラー処理
If CopilotUF.CopilotTryx = 1 Then
Dim mngr As SeleniumVBA.WebDriverManager
Dim keys As SeleniumVBA.WebKeyboard
'Dim Prompts As String
Dim rlt As String
Dim timer As Long
'英訳の場合true
Dim flag As Boolean: flag = False
Set driver = SeleniumVBA.New_WebDriver
Set keys = SeleniumVBA.New_WebKeyboard
Set mngr = SeleniumVBA.New_WebDriverManager
Dim Fullprompts As String, Valsinnrng As String
'WebDriverを自動更新するWebDriverManagerクラスを使用する '0917なぜかエラーが起きたため削除すると機能
'mngr.AlignEdgeDriverWithBrowser
'Edgeを選択してブラウザを開く
driver.StartEdge
Dim caps As WebCapabilities, invisible As Boolean
' invisibleをなくしてもいいように見えるがなくすと画面で出てきてしまう
driver.OpenBrowser caps, invisible = True
'ブラウザCopilotを開く
driver.NavigateTo ThisWorkbook.Worksheets("Info").Range("C3").Value '"https://m365.cloud.microsoft/chat/?auth=2&home=1" '←ブラウザでのコパイロット画面のURLに置き換える
'最小化するとUFへの返答取得表示ができないためブックをActivate
'driver.ActiveWindow.Minimize
BringExcelToFront
End If
driver.Wait 500
If RequestType = "簡易質問" Then
If statuscnt = 0 Then
statuscnt = 100 / 5
statuscntfori = 100 / 5
Else
statuscnt = statuscnt + statuscntfori / 5
End If
Application.StatusBar = " " & "★★実行中です・・・ " & statuscnt & "%" & " / 100%" & "★★"
Fullprompts = InputQ
UFpCopilot = GetCopilotRes(Fullprompts)
ElseIf RequestType = "セル質問" Then
Dim arr As Variant, outArr As Variant
Dim ws As Worksheet, i As Long
Set ws = Inputrng.Parent
'ws.Columns(Inputrng.Columns.Count).Columns '.Insert Shift:=xlToRight
ws.Columns(Inputrng.Columns(Inputrng.Columns.Count).Column + 1).Insert Shift:=xlToRight
With ws.cells(Inputrng.row - 1, Inputrng.Columns(Inputrng.Columns.Count).Column + 1)
.Value = "Copilot結果_指示:" & InputQ
.WrapText = False
End With
Inputrng.Offset(1, -1).WrapText = True
If Inputrng.Count = 1 Then
If Replace(Inputrng.Value, " ", "", , , vbTextCompare) = "" Then
Inputrng.Offset(, 1) = "-"
Else
If statuscnt = 0 Then
statuscnt = 100 / 5
statuscntfori = 100 / 5
Else
statuscnt = statuscnt + statuscntfori / 5
End If
Application.StatusBar = " " & "★★実行中です・・・ " & statuscnt & "%" & " / 100%" & "★★"
Valsinnrng = Replace(Inputrng.Value, vbLf, "")
Fullprompts = InputQ & "--" & Valsinnrng
Inputrng.Offset(, 1) = GetCopilotRes(Fullprompts)
End If
Else
arr = Inputrng.Value ' 一気に読み込み
ReDim outArr(1 To UBound(arr, 1), 1 To 1)
For i = 1 To UBound(arr, 1) 'プロンプトには テンプレか質問 ＶＢＣＲＬＦ ＋rngを入れる。 ＶＢＣＲＬＦは改行される それかーーでも良いかも
'ＶＢＣＲＬＦなら簡易質問のフロー利用可能だが遅延するかも 多分記載なければそのままよいかも
If statuscnt = 0 Then
statuscnt = ((i / UBound(arr, 1)) * 100) / 5
statuscntfori = ((i / UBound(arr, 1)) * 100) / 5
Else
statuscnt = statuscnt + statuscntfori / 5
End If
Application.StatusBar = " " & "★★実行中です・・・ " & statuscnt & "%" & " / 100%" & "★★"
If Replace(arr(i, 1), " ", "", , , vbTextCompare) = "" Then
arr(i, 1) = "-"
statuscnt = (statuscntfori / 5) * 4 + statuscnt
Application.StatusBar = " " & "★★実行中です・・・ " & statuscnt & "%" & " / 100%" & "★★"
Else
Valsinnrng = Replace(arr(i, 1), vbLf, "")
If i = 1 Then 'プロンプトは最初のみ指示で以降はその指示を基本にInputだけを送る
Fullprompts = InputQ & "---" & Valsinnrng
Else
Fullprompts = "次---" & Valsinnrng
End If
outArr(i, 1) = GetCopilotRes(Fullprompts)
End If
Next
ws.cells(Inputrng.row, Inputrng.Columns(Inputrng.Columns.Count).Column + 1).Resize(UBound(outArr, 1), 1).Value = outArr
End If
End If
Application.StatusBar = " " & "★★実行中です・・・ " & statuscnt & "%" & " / 100%" & "★★"
Application.StatusBar = False
statuscnt = 0
statuscntfori = 0
End Function
Private Function GetCopilotRes(Prompts As Variant) As String
' ページが完全に読み込まれるまで待機
Do While driver.ExecuteScript("return document.readyState") <> "complete"
DoEvents
Application.Wait 500 ' 待機（必要に応じて調整）
Loop
'MsgBox "準備完了"
'driver.FindElement(By.ID, "m365-chat-editor-target-element").SendKeys Prompts
'クリップボードにコピーしコピーする方法。Webだと改行がエンターと認識されるため使用不可
Dim texts As Variant
'texts = UserForm1.clipboard.GetText()
'texts = CreateObject("htmlfile").parentWindow.clipboardData.GetData("text")
'driver.FindElementByXPath("//button[@aria-label='Send']").Click
'driver.FindElement(By.ID, "m365-chat-editor-target-element").Click
'If CpilotTargetBox Is Nothing Then
Set CpilotTargetBox = driver.FindElement(By.ID, "m365-chat-editor-target-element")
'End If
Dim txt As String, arr As Variant, i As Long
' 選択範囲をタブ区切りの文字列に変換
'If Not rngtoCopilot Is Nothing Then
' If rngtoCopilot.cells.Count = 1 Then
' txt = rngtoCopilot.Value
' Else
' arr = rngtoCopilot.Value
' For i = 1 To UBound(arr, 1)
' txt = txt & Join(WorksheetFunction.index(arr, i, 0), vbTab) & vbCrLf
' Next i
' End If
'End If
' 改行を入れる（複数行の場合）
'MsgBox txt
'UserForm1.clipboard.SetText txt
'UserForm1.clipboard.PutInClipboard
'target.SendKeys WebKey.CtrlKey + "v"
Dim lines() As String
lines = Split(Prompts, vbCrLf) ' 改行で分割
If UBound(lines) > 0 Then
For i = LBound(lines) To UBound(lines)
CpilotTargetBox.SendKeys lines(i)
CpilotTargetBox.SendKeys WebKey.ShiftKey & WebKey.EnterKey ' 行末で Enter を送る
Next
Else
CpilotTargetBox.SendKeys lines(i)
End If
'Dim txt As String
'txt = Replace(texts, vbCrLf, "\n") ' JS で改行として扱う
'driver.ExecuteScript "arguments[0].innerText = arguments[1];", target, txt
'driver.FindElement(By.ID, "m365-chat-editor-target-element").SendKeys Replace(texts, vbLf, vbLf, , , vbTextCompare)
'09下記で機能していたが､2回目の送信時に動かないこと多くなった
'送が含まれていれば可能
'driver.FindElement(By.XPath, "//button[contains(@aria-label, '送')]").Click
driver.FindElementByXPath("//button[@type='submit' and contains(@class, 'fai-SendButton')]").Click
' driver.FindElementByXPath("//button[@type='submit' and @aria-label='送信']").Click
' driver.FindElementByXPath("//button[@aria-label='Send']").Click
statuscnt = statuscnt + statuscntfori / 5
Application.StatusBar = " " & "★★実行中です・・・ " & statuscnt & "%" & " / 100%" & "★★"
Dim h6Element As Object
Dim respo As Object
''''''''''''''''''''''''''''''''''''''''''''08 AI返信中の判断処理 停止ボタンがあると待つ判定
Dim isResponding As Boolean
Dim stopButton As Object
On Error Resume Next
Set stopButton = driver.PageToHTMLDoc.QuerySelector(".fai-SendButton__stopBackground")
On Error GoTo 0
If Not stopButton Is Nothing Then
isResponding = True
'MsgBox "Copilotは返信中です（停止ボタンが表示されています）"
Else
isResponding = False
'MsgBox "Copilotの返信は完了しています（停止ボタンなし）"
End If
Do
Set stopButton = driver.PageToHTMLDoc.QuerySelector(".fai-SendButton__stopBackground")
DoEvents
Application.Wait Now + TimeSerial(0, 0, 1)
'MsgBox "返答待ち"
Loop While Not stopButton Is Nothing
''''''''''''''''''''''''
statuscnt = statuscnt + statuscntfori / 5
Application.StatusBar = " " & "★★実行中です・・・ " & statuscnt & "%" & " / 100%" & "★★"
'全返答を文字として取得 HTMLではない
'Dim fullResponse As String
'fullResponse = driver.FindElement(By.CssSelector, "div.fai-CopilotMessage__content").GetText
'返答のテキストのみ取得
'GetCopilotRes = fullResponse
statuscnt = statuscnt + statuscntfori / 5
Application.StatusBar = " " & "★★実行中です・・・ " & statuscnt & "%" & " / 100%" & "★★"
Dim responses As Object
Dim latestResponse As String
Dim replyIndex As Integer
' 返信を取得
Set responses = driver.FindElements(By.CssSelector, "div.fai-CopilotMessage__content")
' "CopilotMessage__content" を含むDiv
'Set responses = driver.FindElementsByXPath("//div[contains(@class, 'CopilotMessage__content')]")
' 最新の返信のインデックス（0ベース）
replyIndex = responses.Count
' 最新の返信を取得
latestResponse = responses.Item(replyIndex).GetText
statuscnt = statuscnt + statuscntfori / 5
Application.StatusBar = " " & "★★実行中です・・・ " & statuscnt & "%" & " / 100%" & "★★"
GetCopilotRes = latestResponse
BringExcelToFront
End Function
Sub BringExcelToFront()
Dim hwnd As LongPtr
' Excelのウィンドウタイトルを取得（現在のブック名）
hwnd = FindWindow("XLMAIN", Application.caption)
If hwnd <> 0 Then
SetForegroundWindow hwnd
End If
End Sub
➤UF用コード
Option Explicit
Public clipboard As Object, CopilotTryx As Long:
Private Sub ComboBox1_Change()
Dim temp As String
temp = "テンプレ"
Dim ReqKeyNoi As Long, PromptWs As Worksheet, Prompts As String
Dim Wants As String, Fullprompts As String
Set PromptWs = ThisWorkbook.Worksheets("Info")
On Error Resume Next
ReqKeyNoi = CLng(Left(ComboBox1.Value, InStr(1, ComboBox1.Value, ":", vbTextCompare) - 1))
ReqKeyNoi = WorksheetFunction.match(ReqKeyNoi, PromptWs.Range("B:B"), 0)
If Err.Number <> 0 Then
MsgBox "登録されていない番号です。"
On Error GoTo 0
Exit Sub
End If
On Error GoTo 0
Wants = PromptWs.cells(ReqKeyNoi, 3).Value
Prompts = PromptWs.cells(ReqKeyNoi, 4).Value
Fullprompts = PromptWs.Range("C4")
Dim TargetArr As Variant, InputArr As Variant
TargetArr = Array("#Wants#", "#Prompts#")
InputArr = Array(Wants, Prompts)
Dim i As Long
For i = LBound(TargetArr) To UBound(TargetArr)
Fullprompts = Replace(Fullprompts, TargetArr(i), InputArr(i))
Next
TextBox2 = Fullprompts
End Sub
Private Sub CommandButton1_Click()
On Error Resume Next
Set rngtoCopilot = Application.InputBox("コパイロットに渡す対象セル範囲を入力", , , , , , , 8)
If rngtoCopilot Is Nothing Then Exit Sub
On Error GoTo 0
If Not rngtoCopilot Is Nothing Then
'Dim fullAddress As String
'fullAddress = "'[" & rngtoCopilot.Worksheet.Parent.Name & "]" & rngtoCopilot.Worksheet.Name & "'!" & rngtoCopilot.Address
'Set rngtoCopilot = Application.Range(fullAddress)
If OptionButton1 = True Then '簡単質問
If Not rngtoCopilot Is Nothing Then '簡単質問でセル範囲選択時質問
Dim rowRange As Range
Dim cell As Range
Dim allText As String
For Each rowRange In rngtoCopilot.rows
Dim rowText As String
rowText = ""
For Each cell In rowRange.cells
rowText = rowText & Replace(cell.text, vbLf, " ", , , vbTextCompare) & "," ' タブ区切り（必要に応じてカンマなどに変更可）
Next cell
allText = allText & Left(rowText, Len(rowText) - 1) & vbCrLf ' 最後の区切り文字を削除して改行
Next rowRange
If TextBox1 = "" Then
TextBox1.text = allText
Else
TextBox1.text = TextBox1.text & vbCrLf & allText
End If
'clipboard.SetText allText
'clipboard.PutInClipboard
Else '簡単質問で選択セルが一つの場合
If TextBox1 = "" Then
TextBox1 = rngtoCopilot.text
Else
TextBox1.text = TextBox1.text & vbCrLf & TextBox1
End If
End If
ElseIf OptionButton2 = True Then 'セル質問の場合
'選択した範囲のブック名から情報を代入 'rngtoCopilot.Address(external:=True)
TextBox1.text = "【Book】＝" & rngtoCopilot.Worksheet.Parent.Name & "_" & "【Sheet】=" & rngtoCopilot.Worksheet.Name & "_ " & "【Cell】=" & rngtoCopilot.Address
End If
End If
End Sub
Private Sub CommandButton2_Click()
Dim CopilotRes As String
CopilotTryx = CopilotTryx + 1
'rngtoCopilot.Copy
If ●UFCopilot.RequestType = "簡易質問" Then
CopilotRes = UFpCopilot(, TextBox1)
'簡易質問の場合はUFに回答表示する
If TextBox2.text = "" Then
TextBox2 = CopilotRes
Else
TextBox2 = TextBox2 & vbCr & CopilotRes
End If
Else ' セル質問 セル質問の場合は選択したセル隣に返答を転記する
If rngtoCopilot Is Nothing Then
MsgBox "セル範囲を選択してください。"
Exit Sub
ElseIf TextBox2 = "" Or Len(TextBox2.Value) <= 1 Then
If MsgBox("質問:プロンプトが空欄ですがよろしいですか？", vbYesNo) <> vbYes Then
Exit Sub
End If
End If
'Set rngtoCopilot = Range(TextBox1.text)
Call UFpCopilot(rngtoCopilot, TextBox2)
MsgBox "完了しました。"
End If
End Sub
Private Sub CommandButton3_Click()
If clipboard Is Nothing Then Set clipboard = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
clipboard.SetText TextBox2.Value
clipboard.PutInClipboard
End Sub
Private Sub Label1_Click()
End Sub
Private Sub Label3_Click()
End Sub
Private Sub Label4_Click()
End Sub
Private Sub OptionButton1_Click()
Label3.caption = "質問かセル範囲を入力"
Label1.caption = "Copilot返答"
Label4.Visible = False
ComboBox1.Visible = False
●UFCopilot.RequestType = "簡易質問"
TextBox2 = ""
End Sub
Private Sub OptionButton2_Click()
Label3.caption = "セル範囲を選択"
Label1.caption = "プロンプトを入力"
Label4.Visible = True
ComboBox1.Visible = True
●UFCopilot.RequestType = "セル質問"
TextBox2 = ""
End Sub
Private Sub UserForm_Initialize()
If clipboard Is Nothing Then Set clipboard = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
Dim i As Long
For i = 1 To 50
ComboBox1.AddItem i & ":" & ThisWorkbook.Worksheets("Info").Range("C" & 8 + i - 1).Value
Next
With TextBox2
.MultiLine = True
.ScrollBars = fmScrollBarsVertical
.EnterKeyBehavior = True
.WordWrap = True
.maxLength = 0 ' 無制限（ただし内部制限あり）
End With
With TextBox1
.MultiLine = True
.ScrollBars = fmScrollBarsVertical
.EnterKeyBehavior = True
.WordWrap = True
.maxLength = 0 ' 無制限（ただし内部制限あり）
End With
●UFCopilot.RequestType = "セル質問"
Me.width = 350
Me.height = 280
End Sub
Private Sub ComboBox1_Enter()
' リストがある場合、自動でドロップダウンを開く
If Me.ComboBox1.ListCount > 0 Then
Me.ComboBox1.DropDown
End If
End Sub
ポイント機能
・UF上での回答取得とセル範囲による回答取得
・セル質問時の配列による返答高速化
UF上での回答取得とセル範囲による回答取得
UFではUF上での回答取得とセル範囲による回答取得を選択できます。前者はUFのテキストボックスに入れた値を質問し、返答がUFの返答ボックスに表示されます。後者は、シート上の選択した範囲を質問とし、さらにプロンプトを質問入力テキストボックスに入力した上で二つの文字列を質問し、返答を選択したセルの右に記載します。
セル範囲質問では、プロンプトが選択したセルの右上のセルに記載され、それぞれのセル右に返答が転記されます。これにより、返答がどのようなプロンプトかを把握することができます。
テンプレはInfoシートに追加可能です。やりたい事概要と、プロンプト詳細列に記載された値がプロンプトに登録された、#Wants##Prompts#と置き換えられます。＃＃のキーワードは変更しないでください。
セル質問時の配列による返答高速化
セル質問時の返答取得は、セル分の値と返答格納する配列を宣言し、最後に転記しています。
arrはプロンプトとなるセル値格納する配列で、outArrは返答を格納する配列です。arrに選択セル範囲の値Inputrng.valueを格納し、outArr腫れ一をReDimでarr配列文の二次元配列とします。列は一列なので一次元でもよいように思えますが、セル値に転記する際は二次元である必要があるため上記のような再定義をしています。
そして、セル範囲ごとのForループインデックスであるiを引数に、Copilot返答取得関数の戻り値を格納していきます。
セル質問時の返答は選択したセルに応じて返答を得るまでの処理が多くなります。エクセル上で値をセルにコピーする際は、単純にValueプロパティに代入すればよいのですが、これは代入の回数が増えるほど処理負荷が重く、よって処理に時間が掛かってしまいます。その為、一括ペーストすることで高速化しています。