質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

2回答

8757閲覧

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

sane

総合スコア27

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2020/03/11 04:25

編集2020/03/11 05:07

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

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

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

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

Visual

1Sub 画像読み込み() 2 3 Dim lngTop As Long 4 5 '--- フォルダのパス ---' 6 Dim folderPath As String 7 folderPath = ThisWorkbook.Path & "/images" 8 '--- ファイル名(ワイルドカードを使用) ---' 9 Dim fileName As String 10 fileName = "*" 11 12 '--- Dir関数の戻り値を格納する変数 ---' 13 Dim tmp As String 14 15 tmp = Dir(folderPath & "/" & fileName) 16 lngTop = 20 17 Do While tmp <> "" 18 19 Dim file As String 20 file = folderPath & "/" & tmp 21 Debug.Print file 22 23 ActiveSheet.Shapes.AddPicture _ 24 fileName:=file, _ 25 LinkToFile:=False, _ 26 SaveWithDocument:=True, _ 27 Left:=20, _ 28 Top:=lngTop, _ 29 Width:=300, _ 30 Height:=200 31 32 '--- こっちも試したけど無理でした ---' 33 'With ActiveSheet.Pictures.Insert(fileName:=file) 34 ' .Top = lngTop 35 ' .Left = 20 36 ' .Width = 300 37 ' .Height = 200 38 ' End With 39 40 lngTop = lngTop + 200 + 20 41 tmp = Dir() 42 Loop 43 44 45End Sub

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答2

0

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

投稿2020/03/11 05:01

ttyp03

総合スコア16996

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

sane

2020/03/11 05:05

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

2020/03/11 05:18

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

2020/03/11 05:25

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

2020/03/11 05:35

いえ、お役に立てず申し訳ないです。 メソッドが用意されているくらいなので使えないということはないと思います。 同じような質問を発見。 https://teratail.com/questions/113899
guest

0

自己解決

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

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

python

1import openpyxl 2import pathlib 3import subprocess 4 5heicdir =''# HEIC形式の写真があるディレクトリ 6jpegdir = ''# JPEG形式の写真があるディレクトリ 7 8files = sorted(pathlib.Path(heicdir).glob('*.heic')) 9 10i = 1 11 12for f in files: 13 print(f.name) 14 cmd = 'sips --setProperty format jpeg ' + heicdir + f.name + ' --out ' + jpegdir + 'photo-' + str(i).zfill(7) + '.jpeg' 15 subprocess.call(cmd, shell=True) 16 i+=1 17 18files_j = sorted(pathlib.Path(jpegdir).glob('*.jpeg')) 19 20for f in files_j: 21 cmd = 'jpegoptim -S200 ' + jpegdir + f.name 22 subprocess.call(cmd, shell=True) 23 24 25p_temp = sorted(pathlib.Path(jpegdir).glob('*.jpeg')) 26wb = openpyxl.Workbook() 27ws = wb.worksheets[0] 28 29j = 0 30 31for p in p_temp: 32 print(p) 33 img = openpyxl.drawing.image.Image(jpegdir+p.name) 34 img.width = 200 35 img.height = 200 36 37 if j%5 == 0: 38 ws.add_image(img , 'A'+ str((j//5)*12+3)) 39 elif j%5 == 1: 40 ws.add_image(img , 'D'+ str((j//5)*12+3)) 41 elif j%5 == 2: 42 ws.add_image(img , 'G'+ str((j//5)*12+3)) 43 elif j%5 == 3: 44 ws.add_image(img , 'J'+ str((j//5)*12+3)) 45 elif j%5 == 4: 46 ws.add_image(img , 'M'+ str((j//5)*12+3)) 47 48 j+=1 49 50wb.save('out.xlsx')

投稿2020/03/11 09:15

sane

総合スコア27

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問