VBA Excelでの画像インポート（shapes.addpicture、pictures.insert）がうまくいかない

Question

エクセルVBAについて、iPhoneからAirDropで送ったHEIC画像を自動的に所定の位置にエクセルに貼り付けるプログラムを作成しています。

このコードを走らせると、エクセル側で「このファイルのインポート中にエラーが発生しました。（ファイルURL）」と表示され、Visial Basicでは実行時エラー’1004’アプリケーション定義またはオブジェクト定義のエラーです。と表示されます。Shapes.addpictureとPictures.Insertメソッドを試しましたが、両方うまく行きませんでした。

環境はMacで、JPGなどの画像にしてもうまくインポートされませんでした。ドラッグドロップだとエクセルに画像を貼ることができます。一度ドラッグドロップでシートに貼った画像であればその画像は自動で貼り付けることができます。

VBAに詳しい方、ご回答頂けると幸いです。

Sub 画像読み込み()

    Dim lngTop As Long

    '--- フォルダのパス ---'
    Dim folderPath As String
    folderPath = ThisWorkbook.Path & "/images"
    '--- ファイル名（ワイルドカードを使用） ---'
    Dim fileName As String
    fileName = "*"
    
    '--- Dir関数の戻り値を格納する変数 ---'
    Dim tmp As String
    
    tmp = Dir(folderPath & "/" & fileName)
    lngTop = 20
    Do While tmp <> ""
    
        Dim file As String
        file = folderPath & "/" & tmp
        Debug.Print file
        
        ActiveSheet.Shapes.AddPicture _
                fileName:=file, _
                LinkToFile:=False, _
                SaveWithDocument:=True, _
                Left:=20, _
                Top:=lngTop, _
                Width:=300, _
                Height:=200
        
        '--- こっちも試したけど無理でした ---'
        'With ActiveSheet.Pictures.Insert(fileName:=file)
        '   .Top = lngTop
        '    .Left = 20
        '    .Width = 300
        '   .Height = 200
       ' End With
        
        lngTop = lngTop + 200 + 20
        tmp = Dir()
    Loop


End Sub

Answer 1

基本的に対応していない画像フォーマットと思われます。
環境がWindowsであれば、以下に紹介されている拡張機能を導入してみてはいかがでしょうか。
https://pcmanabu.com/windows-10-heic/#i-2

Comments

[sane]

JPGなどに変換してもインポートエラーが出ます。

[ttyp03]

ごめんなさい、思い切りMacって書いてありましたね。
当方Windows環境なので解決はできませんが、ご提示のコードを試してみました。
少なくともJPEGであれば両方のコードで貼り付けができました。
ちなみにHEICから変換したものではなく、最初からJPEGの画像でも同様なのでしょうか？

[sane]

もともとJPG画像でもエラーが出ます。MACだとできないということはありえるんですかね？ご対応ありがとうございます。

[ttyp03]

いえ、お役に立てず申し訳ないです。
メソッドが用意されているくらいなので使えないということはないと思います。

同じような質問を発見。
https://teratail.com/questions/113899

Answer 2

Apple社とMicroSoft社は仲が良くないようで、うまくいかないVBAでの実装を諦めPythonのOpenpyxlライブラリを用いて実装しました。HEIC画像を取り込み、JPEGに変換し、圧縮し、エクセルに乗せてから書き出しています。

参考URL：
https://keejaiva.net/heic2jpeg/
https://qiita.com/3000manJPY/items/6100452792e16d0ae921

import openpyxl
import pathlib
import subprocess

heicdir =''# HEIC形式の写真があるディレクトリ
jpegdir = ''# JPEG形式の写真があるディレクトリ

files = sorted(pathlib.Path(heicdir).glob('*.heic'))

i = 1

for f in files:
        print(f.name)
        cmd = 'sips --setProperty format jpeg ' + heicdir + f.name + ' --out ' + jpegdir + 'photo-' + str(i).zfill(7) + '.jpeg'
        subprocess.call(cmd, shell=True)
        i+=1

files_j = sorted(pathlib.Path(jpegdir).glob('*.jpeg'))

for f in files_j:
        cmd = 'jpegoptim -S200 ' + jpegdir + f.name
        subprocess.call(cmd, shell=True)
        

p_temp = sorted(pathlib.Path(jpegdir).glob('*.jpeg'))
wb = openpyxl.Workbook()
ws = wb.worksheets[0]

j  = 0  

for p in p_temp:
    print(p)
    img = openpyxl.drawing.image.Image(jpegdir+p.name)
    img.width = 200
    img.height = 200
    
    if j%5 == 0:
        ws.add_image(img ,  'A'+ str((j//5)*12+3))
    elif j%5 == 1:
        ws.add_image(img ,  'D'+ str((j//5)*12+3))
    elif j%5 == 2:
        ws.add_image(img ,  'G'+ str((j//5)*12+3))
    elif j%5 == 3:
        ws.add_image(img ,  'J'+ str((j//5)*12+3))
    elif j%5 == 4:
        ws.add_image(img ,  'M'+ str((j//5)*12+3))
        
    j+=1

wb.save('out.xlsx')