エクセル マクロ 画像についての質問です。

質問

エクセル マクロについての質問です。

下記のコードでセルに画像を合わせて貼り付け、表を作成しています。
が、このコードだと画像の保存先を移動させると画像が表示されなくなり、分類でフィルターをかけるとバラバラの違う画像が表示されてしまったりして困っています・・・。
どなたか良いご意見を頂ければと思い、投稿しました。よろしくお願いします！

Sub PictFit()
Dim PicFile As String
Dim Pic As Picture

PicFile = Application.GetOpenFilename() '画像のパスを取得
If PicFile = "False" Then Exit Sub
Set Pic = ActiveSheet.Pictures.Insert(PicFile) '画像を貼り付ける
With Pic
.Height = ActiveCell.MergeArea.Height '画像の高さ
.Top = ActiveCell.Top '画像の上位置を変更
.Left = ActiveCell.Left + (ActiveCell.MergeArea.Width - .Width) / 2 '画像の横位置を変更(セル幅中央に画像中央)
End With
End Sub

回答No.1

kkkkkm · ベストアンサー

図をリンク オブジェクトではなく図として挿入するには、Pictures.Insert メソッドではなく、Shapes.Add メソッドを使用してください。

とのことです。
こちらを参考にしてください。
https://support.microsoft.com/ja-jp/kb/2396509

回答No.5

imogasi

質問の趣旨がどこかよくわからない。コードだけコピペして判るものか？
小生が、見当違いならスルーしてください。
＞A.だと画像の保存先を移動させると
挿入する写真の保存先を移動する（他人や自分か？）というばいい場合のことか？
移動したら、自動でプログラムの必要な部分が書き変わったり、その他の仕組みで今までと変わらず表示する方法はないだろう。そういうしくみが普通では、システムに備わってないと思う。
変更の履歴でもたどれるようになっていないとね。
WEBの記事の在りかでも、プログラムのあり場所でも同じではないか。
もしあるのならその回答で、ぜひ勉強したいくらい。
＞B。分類でフィルターをかけるとバラバラの違う画像が表示
の意味はもう少しなんのことか説明が要るだろう。
ーー
質問で、コードをコピペしているが、こちらでやってみても、質問の疑問点Aとは直接関係がないのではないか。
写真は複数個（複数セルに）持ってくるのではないのか？１つずつ実行するのは普通しないでしょう。
質問を小生が理解するためやってみて、改良せざるを得なかった。
しかし質問点Aを解決するものでは全くない。
やってみると
（１）あるピクチャ・ホルダに、セルに表示する写真が複数枚あるとする。
（２）セルの幅と行高を適当に実行前にしておく
（３）実行して、ファイル選択の画面でSHIFTキーを押しながら複数の写真ファイルをクリックして選択する。
Sub test01()
'Sub PictFit()
Dim PicFile As Variant
Dim Pic As Picture
ActiveSheet.DrawingObjects.Delete
Worksheets("Sheet1").Cells(1, 1).Select
PicFile = Application.GetOpenFilename(MultiSelect:=True) '画像のパスを取得
' If PicFile = "False" Then Exit Sub
'MsgBox Pictile
If IsArray(PicFile) Then
For Each f In PicFile
MsgBox f
Set Pic = ActiveSheet.Pictures.Insert(f) '画像を貼り付ける
With Pic
.Height = ActiveCell.Height '画像の高さ
.Top = ActiveCell.Top '画像の上位置を変更
.Left = ActiveCell.Left '画像の横位置を変更
.Width = ActiveCell.Width
End With
ActiveCell.Offset(1, 0).Select
Next
Else
MsgBox PicFile
End If
End Sub

回答No.4

chie65536（@chie65535）

追記。

=SUBTOTAL(102,範囲)

の範囲は、フィルタがC列に対してかけられているなら

=SUBTOTAL(102,C:C)

のようにして下さい。

また、SUBTOTALの結果をシート上に表示したくないなら、どこかの空白セルに入力して、文字を白に設定して下さい。

回答No.3

chie65536（@chie65535）

＞このコードだと画像の保存先を移動させると画像が表示されなくなり

ActiveSheet.Pictures.Insertメソッドは「画像のリンクを挿入するだけ」であり、画像そのものは挿入しないので「元画像を移動させてはいけない」です。

従って「Shapeを新規作成して、Shapeに画像を流し込む」など、他の方法を使用せねばなりません。

＞分類でフィルターをかけるとバラバラの違う画像が表示されてしまったりして

フィルタでセルが非表示になった場合、追従して、そのセルに貼られたPictureを非表示にするには、以下のようにして下さい。

１．シートの何処かのセルに、ワークシート関数で「=SUBTOTAL(102,フィルタ範囲)」と言う式を入れます。このワークシート関数があると「フィルタを実行した時」に「該当シートのCalculateイベント」が呼ばれるようになります。

２．シートのイベントプロシージャに、以下のイベントを挿入します。

Private Sub Worksheet_Calculate()
Dim Pic As Picture

For Each Pic In ActiveSheet.Pictures
Pic.Visible = Not ActiveSheet.Cells(Pic.TopLeftCell.Row, Pic.TopLeftCell.Column).EntireRow.Hidden
Next

End Sub

シート状で「フィルタ」を変更すると、このイベントプロシージャが呼ばれ「Pictuteが貼りついているセルがフィルタで非表示状態になってたら該当Pictuteを非表示状態にする、セルがフィルタで表示状態になってたら該当Pictureを表示状態にする」という処理が行なわれます。

回答No.2

kkkkkm

No1です
こちらの最後の方法でも
https://www.moug.net/tech/exvba/0120020.html