ここから本文です

マクロについての質問です。 H列に品名を入力すると、M列に指定フォルダ内の同じ...

tir********さん

2012/7/2315:45:45

マクロについての質問です。
H列に品名を入力すると、M列に指定フォルダ内の同じ品名の
画像が表示されるようになっています。

現在画像は、Pictures.Insert メソッドを使用して
ワークシートに挿入されており、リンク オブジェクトとして挿入されます。
そのため、リンク元となる元の図を移動、または削除した場合や
、図の名前を変更した場合に、挿入された図がリンク枠として表示され、
リンク枠内にエラー メッセージが表示されてしまって困っています。

どなたか画像を、リンク オブジェクトではなく、画像として挿入するために、
Pictures.Insert メソッドではなく、Shapes.Add メソッドを
使用したマクロに書き換え、この不具合を回避できないでしょうか?

お時間ありましたら、どうぞよろしくお願いします。


VBAは下記↓になります。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myWidth As Double, myHeight As Double
myWidth = Target.Offset(, 5).Width
myHeight = Selection.Height
If Target.Count > 1 Then Exit Sub '複数セルDelete用
If Intersect(Target, Range("H:H")) Is Nothing Then Exit Sub
If Target.Value = "" Then Exit Sub
Dim FName As String
FName = "C:/画像".jpg"
If Dir(FName) <> "" Then
Target.Offset(0, 5).Activate
ActiveSheet.Pictures.Insert(FName).Select
If Selection.Width > Target.Offset(0, 5).Width Or Selection.Height > Target.Offset(0, 5).Height Then
If Selection.Width / Target.Offset(0, 5).Width > Selection.Height / Target.Offset(0, 5).Height Then
Selection.Height = Selection.Height * (Target.Offset(0, 6).Width / Selection.Width)
Selection.Width = Target.Offset(0, 5).Width
Else
Selection.Width = Selection.Width * (Target.Offset(0, 6).Height / Selection.Height)
Selection.Height = Target.Offset(0, 5).Height
End If
End If

' 表示位置をセル中央に移動
Selection.Top = Target.Offset(0, 5).Top + (Target.Offset(0, 5).Height - Selection.Height) / 2
Selectio

補足>以前のように、H列は数式等による入力ではないですよね ?
別シートに各取引先の名前をつけたリストがあり、
データ入力の規則で"E列"の取引先を選ぶと"H列"に
データ入力の規則でE列で選択した取引先名のリストが出て、
そこから商品名を選ぶ仕組みです。
>又、H列ですが、添付された画像から8行目からでしょうか ?
8行目です!

◆別パソコンで画像が表示されず困ってしまったことです。

Target.Offset,リンク オブジェクト,Height Then,If Target.Value,If Target.Count,Pictures.Insert,Target.Address

閲覧数:
1,394
回答数:
2
お礼:
25枚

違反報告

ベストアンサーに選ばれた回答

mie********さん

編集あり2012/7/2419:30:15

H列でのデータ入力規則(による商品名入力)に、
対応させたコードに修正してみました。
(前のコ-ドでは、入力規則があるとエラ-が出ることを確認)


Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Shp As Shape, Fnm As String
Dim Cel As Range
Dim aw, bw, ah, bh, x, y

On Error GoTo ErrInf

If Intersect(Target, Range("H8:H" & Rows.Count)) Is Nothing Then Exit Sub
If Target.Value = "" Or Target.Count > 1 Then Exit Sub

Application.ScreenUpdating = False

For Each Shp In Me.Shapes
If Shp.Name = "画像-" & Target.Address Then
Shp.Delete
End If
Next

Fnm = "C:\画像\" & Target.Value & ".jpg"

If Dir(Fnm) = "" Then
Exit Sub
End If

Set Cel = Target.Offset(, 5)

With Cel
With Me.Shapes.AddPicture(CStr(Fnm), msoFalse, msoTrue, .Left, .Top, 0, 0)
.Name = "画像-" & Target.Address
.ScaleHeight 1, msoTrue
.ScaleWidth 1, msoTrue
.LockAspectRatio = msoTrue
.Placement = xlFreeFloating
End With
End With

With Me.Shapes("画像-" & Target.Address)

If Cel.Height < Cel.Width Then
.Height = Cel.Height
Else
.Width = Cel.Width
End If

aw = Cel.Width
bw = .Width
x = (aw - bw) / 2
.Left = .Left + x

ah = Cel.Height
bh = .Height
y = (ah - bh) / 2
.Top = Cel.Top + y

End With

Application.ScreenUpdating = True

Exit Sub

ErrInf:
MsgBox Err.Number & "_ " & Err.Description
End Sub


※ 画像に名前をつけているのは、
目的のセルに重複して画像を挿入しないためです。

※ Excel 2010 で
Pictures.Insert メソッド
を使用した場合の不具合と回避策は、
下記を参考にしています。
http://support.microsoft.com/kb/2396509/ja
http://www.moug.net/tech/exvba/0120020.html

質問した人からのコメント

2012/7/25 10:30:02

miekirukabukiage様
いつもご回答いただけまして、本当にありがとうございます!
今回も無事に別PCで画像を開くことができ、解決されました。
しかし、やはり横長の画像はセルないに収まりきれずに
隣のセルにはみ出して隣のセルを隠してしまいました。
こちらは、画像自体の大きさを変えるしかないのでしょうか?

お時間いただきまして、今回も本当にありがとうございました!

ベストアンサー以外の回答

1〜1件/1件中

kou********さん

2012/7/2318:14:18

>リンク元となる元の図を移動、または削除した場合や
>、図の名前を変更した場合に、挿入された図がリンク枠として表示され、
>リンク枠内にエラー メッセージが表示されてしまって困っています。
この現象が納得いかないですね。
Pictures.Insert で一旦シート内に取り込まれた画像は、元のファイルの有無に限らずExcel内で管理されています。元のファイルが削除されたからといって「リンク切れ」のような症状は起こらないはずですが...。

>Pictures.Insert メソッドではなく、Shapes.Add メソッドを
>使用したマクロに書き換え
Pictures.Insertを使用して取り込んだものも、EXCELの中では1種類のオートシェープとして管理されているのはご承知なのかと。
ご指摘のようなことができたとしても同じオートシェープなので、結果は期待できるものではないのかと。

>FName = "C:/画像".jpg"
このコードは明らかに構文エラーが出るコード。このような質問されるときには、正しく作動するものをアップされるべきなのかと。

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる