Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Pro : Excel 2016)
画像取得
投稿日時: 21/08/23 19:44:01
投稿者: EXman

お世話になっております。
当方、VBA初心者です。
 
以前、ファイル名からエクセルに画像を張り付けるマクロを有志の方に教えて頂いたんですが、
画像が保存されず、リンクが保存されてしまうマイクロソフトのバグがあるようで、
これを画像そのものを保存できるようにしたいです。
 
ActiveSheet.Pictures.InsertをActiveSheet.Shapes.AddPictureに変更する必要があるようですが、
以下のコード内の変更をどうすれば良いかわかりません。
 
どうか教えて頂きたく存じます。
何卒宜しくお願い致します。
------------------------------------------------------------------
Sub ImageSelecter()
Dim p As String
Dim h As Range
 
'写真保存場所
p = "画像のパス"
 
'現在表示されてる画像を一度削除
ActiveSheet.Pictures.Delete
 
'画像名が入力されている行まで繰返
For Each h In Range("A3:A" & Range("A1048576").End(xlUp).Row)
 
'写真ファイルが保存されている時
If Dir(p & h) <> "" Then
With ActiveSheet.Pictures.Insert(p & h)
 
'画像ファイル名が入力されているセルから二つ左のセルに挿入
.Top = h.Offset(0, 1).Top
.Left = h.Offset(0, 1).Left
'写真サイズの設定
.Width = h.Offset(1, 0).Width
.Height = h.Offset(0, 0).Height
End With
End If
Next
End Sub

回答
投稿日時: 21/08/23 20:23:09
投稿者: コレ

 こんばんは
 有志の方から提示されたコードということですが、コードを理解しないまま使っていますと、
仕様変更になった場合に困ると思うので、理解した上で使用することおススメ致します。
 
質問の内容から下記の部分を、
With ActiveSheet.Pictures.Insert(p & h)
'画像ファイル名が入力されているセルから二つ左のセルに挿入
.Top = h.Offset(0, 1).Top
.Left = h.Offset(0, 1).Left
'写真サイズの設定
.Width = h.Offset(1, 0).Width
.Height = h.Offset(0, 0).Height
End With
 
この一行に変更すれば良さそうだと推測しました。
一応、私のPCでも画像を表示するだけですが出来ました。
 ActiveSheet.Shapes.AddPicture p, msoTrue, msoTrue, h.Offset(0, 1).Left, h.Offset(0, 1).Top, h.Offset(1, 0).Width, h.Offset(0, 0).Height
 
msoTrueの部分は適宜変更してください。(msotrue/msofalse)
参考になればと思います。

回答
投稿日時: 21/08/23 20:25:44
投稿者: WinArrow
投稿者のウェブサイトに移動

Addpictureの構文です。
参考にして、置き換えてみてください。
 
式.AddPicture (FileName, LinkToFile, SaveWithDocument, Left, Top, Width, Height)

回答
投稿日時: 21/08/24 07:08:18
投稿者: simple

すでに回答頂いているとおりです。
(1)
こちらのサイトの「即効テクニック」も参照してください。
「画像ファイルを挿入する」
https://www.moug.net/tech/exvba/0120020.html
そこに記載されているように、

引用:
Excel 2007までは画像情報と一緒に保存されていたのに対し、Excel 2010以降ではリンク貼り付けに仕様が変わるなど、Excelのバージョンによって画像の保存方法が異なります。
ということです。仕様変更でありバグではありません。(ユーザーには同じかも)
大分、昔の話になりましたけどね。
 
(2)
ちなみに、以下、細かい話で恐縮です。
>セルから二つ左のセルに挿入
というのが変です。対象がA列のようですし、一つ右の列ではないですか?
まあ、それはコメントだからよいとして、
   .Width = h.Offset(1, 0).Width
とすると、A列とB列の幅が違ったときには、B列の横幅に収まらないかと。
OffsetはすべてOffset(0, 1)で統一したらまずいのですか?

回答
投稿日時: 21/08/24 07:34:30
投稿者: WinArrow
投稿者のウェブサイトに移動

質問者さんが理解しているかどうかわかりませんが、
A列セルの画像ファイル名で画像を取り込み、
対応するB列に画像を貼付けたいと仕様のようです。
貼付け位置は、
上端:B列セル(A列セルでもよい)
左端:B列セル
横幅:A列セルの横幅
高さ:B列セル(A列セルでも同じ)の高さ
というような説明があるとよいですね・・・・
 
大事なこと
コードは、インデントをきちんとつけましょう。
 

回答
投稿日時: 21/08/24 08:06:03
投稿者: simple

Left,Top,Width,Heightが決まっている今回のパターンは比較的簡単ですね。
ただ、これだと縦横比が元と違ってしまう可能性がある点が気になります。
 
縦横比を保存して、縦の長さだけ指定(または、幅だけを指定)するのは
ちょっと手間がかかるけれど、手法は確立しています。
Left,Topは決まっているので、.widthと.heightともに -1 を指定していったん挿入し、
その後に、実際の.width(もしくはHeight)を指定する、
という方法があるようです。(ネットで検索すると色々でてきます)
# ちょっと本題からずれて失礼。

投稿日時: 21/08/24 10:01:49
投稿者: EXman

コレ 様
 
ご教示ありがとうございます。
 
ご指摘の通りコード理解が出来ておりません。
申しわけありませんでした。
 
ご指導頂きました内容で無事画像挿入出来ました。
ちょっとずつ勉強していきたいと思いました。
引き続きよろしくお願いいたします。
 
 

コレ さんの引用:
 こんばんは
 有志の方から提示されたコードということですが、コードを理解しないまま使っていますと、
仕様変更になった場合に困ると思うので、理解した上で使用することおススメ致します。
 
質問の内容から下記の部分を、
With ActiveSheet.Pictures.Insert(p & h)
'画像ファイル名が入力されているセルから二つ左のセルに挿入
.Top = h.Offset(0, 1).Top
.Left = h.Offset(0, 1).Left
'写真サイズの設定
.Width = h.Offset(1, 0).Width
.Height = h.Offset(0, 0).Height
End With
 
この一行に変更すれば良さそうだと推測しました。
一応、私のPCでも画像を表示するだけですが出来ました。
 ActiveSheet.Shapes.AddPicture p, msoTrue, msoTrue, h.Offset(0, 1).Left, h.Offset(0, 1).Top, h.Offset(1, 0).Width, h.Offset(0, 0).Height
 
msoTrueの部分は適宜変更してください。(msotrue/msofalse)
参考になればと思います。

投稿日時: 21/08/24 10:03:28
投稿者: EXman

WinArrow 様
 
ご教示ありがとうございます。
VBAまだ初心者で一歩ずつ進めていきたいと思います。
こちらを参考に新たなものを作成したいと思います。
引き続きよろしくお願いいたします。
 

WinArrow さんの引用:
Addpictureの構文です。
参考にして、置き換えてみてください。
 
式.AddPicture (FileName, LinkToFile, SaveWithDocument, Left, Top, Width, Height)