IMAGE関数(みたいなの)を普通のExcelでも使いたい!
2024年9月15日Excelに、
IMAGE関数とかいう、めちゃくちゃ便利な関数があるんですが、、、
365のみの関数で、
Excel2021、Excel2019、Excel2016、Excel2013では、使えないんですよね。
13とか16とかいう古いExcelを使うことはないにしても、最近買ったPCですら使えないという。
でも、どうしても、使いたかったので、VBAで無理やり実装するメモ。
※みたいなものを
やりたいこと
●セルC3 と、C8に、画像のURLが入り、
その隣のB3と、B8にURLに対応する画像が表示される。
VBA のSheet1(Sheet1)をダブルクリックした入力欄に、以下を。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim imageURL As String
‘ C3:C8セルの範囲にURLが入力された場合に対応
If Not Intersect(Target, Me.Range(“C3:C8”)) Is Nothing Then
Application.EnableEvents = False ‘ 無限ループを防ぐ
For Each cell In Target
If IsValidURL(cell.Value) Then
‘ URLセルの左隣(B列)に画像を挿入
InsertImageFromURL cell.Offset(0, -1), cell.Value
End If
Next cell
Application.EnableEvents = True ‘ イベントを再度有効にする
End If
End Sub
‘ URLの有効性をチェックする関数
Function IsValidURL(url As String) As Boolean
On Error Resume Next
Dim test As Object
Set test = CreateObject(“MSXML2.XMLHTTP”)
test.Open “GET”, url, False
test.send
IsValidURL = (test.Status = 200)
On Error GoTo 0
End Function
メニューの挿入から、標準モジュールをクリックして、
左側に追加された、標準モジュール内の、Module1に、以下を入力。
Function InsertImageFromURL(targetCell As Range, imageURL As String)
Dim ws As Worksheet
Dim img As Picture
Set ws = targetCell.Worksheet
‘ 既存の画像を削除
For Each img In ws.Pictures
If Not Intersect(img.TopLeftCell, targetCell) Is Nothing Then
img.Delete
End If
Next img
‘ 画像を挿入
On Error Resume Next
Set img = ws.Pictures.Insert(imageURL)
On Error GoTo 0
If Not img Is Nothing Then
With img
.Top = targetCell.Top
.Left = targetCell.Left
.Width = targetCell.Width
.Height = targetCell.Height
End With
Else
MsgBox “画像を挿入できませんでした。URLを確認してください。”, vbExclamation
End If
End Function
それだけ。
※共有して使うときは、いつものExcelブロック解除の様に、Excelを右クリック、マクロの許可をしてから、開く。
AIに作ってもらったコードなので、書き換えたりしていい感じに加工する時も、
AIにお願いしたら便利かも?