[[20110927163834]]　『画像が表示されなくなります。』（あき）　ページの最後に飛ぶ

『画像が表示されなくなります。』（あき）

エクセル2010で下記のマクロを実行し、

画像挿入元のフォルダ名を変更したり、

画像データを削除すると

「リンクされたイメージを表示できません。ファイルが移動または削除されたか、名前が変更された可能性があります。リンクに正しいファイル名と場所が指定されていることを確認してください。」

と表示されています。

調べた結果このマクロは、Pictures.Insert メソッドである事はわかりました。

しかし、2010では、Shapes.Add メソッドを使用するとの事なのですが、

ファイルは頂いたものなので、どこを修正したらいいのかわかりません。

このファイルは使う事が多いので教えていただけると助かります。

よろしくお願いいたします。

 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim myPic
    Dim myRange As Range '画像を配置するセル範囲
    Dim rX As Double, rY As Double

    myPic = Application.GetOpenFilename("画像ファイル,*.jpg;*.jpeg;*.gif;*.tif")
    If VarType(myPic) = vbBoolean Then Exit Sub

    Set myRange = Target 'このセル範囲に収まるように画像を縮小する
    Application.ScreenUpdating = False
    With ActiveSheet.Pictures.Insert(myPic).ShapeRange
        rX = myRange.Width / .Width
        rY = myRange.Height / .Height
        If rX > rY Then
            .Height = .Height * rY
        Else
            .Width = .Width * rX
        End If
        .Left = .Left + (myRange.Width - .Width) / 2 '写真を横方向の中央に配置
        .Top = .Top + (myRange.Height - .Height) / 2 '写真を縦方向に中央に配置
    End With
    Application.ScreenUpdating = True
    Cancel = True
End Sub

 以前回答したものですが、ここら辺が参考になりませんか？
　[[20110117143927]]　『マクロを使ってＥｘｃｅｌ2010で作ったファイルを』（ｍｓｄ）
　[[20110324093457]]　『どこを変更したらいいですか？』（あき）

 （ｍｏｍｏ）

下記のように書き換えて無事に出来ました。

とりあえず試したところ無事に動いてます。

ヒントを与えてくださってありがとうございました。

 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim myPic
    Dim myRange As Range '画像を配置するセル範囲
    Dim rX As Double, rY As Double

    myPic = Application.GetOpenFilename("画像ファイル,*.jpg;*.jpeg;*.gif;*.tif")
    If VarType(myPic) = vbBoolean Then Exit Sub

    Set myRange = Target 'このセル範囲に収まるように画像を縮小する
    Application.ScreenUpdating = False
    With ActiveSheet.Shapes.AddPicture(Filename:=myPic, _
            LinkToFile:=False, SaveWithDocument:=True, _
            Left:=Selection.Left, Top:=Selection.Top, _
            Width:=50#, Height:=50#)
        .ScaleHeight 1, msoTrue
        .ScaleWidth 1, msoTrue
        .LockAspectRatio = msoTrue
        .Height = Target.Height
        rX = myRange.Width / .Width
        rY = myRange.Height / .Height
        If rX > rY Then
            .Height = .Height * rY
        Else
            .Width = .Width * rX
        End If
        .Left = .Left + (myRange.Width - .Width) / 2 '写真を横方向の中央に配置
        .Top = .Top + (myRange.Height - .Height) / 2 '写真を縦方向に中央に配置
    End With
    Application.ScreenUpdating = True
    Cancel = True
End Sub

（あき）

コメント返信：

[ 一覧(最新更新順) ]

[[20110927163834]] 『画像が表示されなくなります。』（あき） ページの最後に飛ぶ

[[20110927163834]]　『画像が表示されなくなります。』（あき）　ページの最後に飛ぶ