画像をアクティブセルの左上隅に配置し任意のセルに
画像をアクティブセルの左上隅に配置し任意のセルにその画像ファイル名を自動で入力したいです
やりたいことは以下になります
例えば画像をアクティブセル（D2）の左上隅に貼り付けて
貼り付けた画像のファイル名をC2に自動で入力をしたいです
ファイル名に関しては拡張子も明記するコードとしないコード二つご教授して頂けると大変嬉しいです
下記のコード二つを組み合わせればできそうなんですが
どのようにしたらいいのか分かりません
よろしくお願いします
Sub 図形挿入()
Dim FilePath As Variant
FilePath = Application.GetOpenFilename(",*.png")
If Not FilePath = False Then
ActiveSheet.Pictures.Insert(FilePath).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Width = Selection.ShapeRange.Width * 1#
Selection.ShapeRange.Left = ActiveCell.Left + 2.25
Selection.ShapeRange.Top = ActiveCell.Top + 2.25
With Selection.ShapeRange.Line
.Weight = 2.25 '線の太さを2.25に
.ForeColor.RGB = RGB(255, 0, 0) '赤枠に
End With
End If
End Sub
Sub ファイル名をセルに入力()
Dim OpenFileName As String
Dim tmp As Variant
OpenFileName = Application.GetOpenFilename(FileFilter:="画像 ,*.png; *.jpg; *.gif; *.bmp", Title:="ファイルの選択")
If OpenFileName <> "False" Then
tmp = Split(OpenFileName, "\")
Range("C2").Value = tmp(UBound(tmp))
End If
End Sub
お礼
助かりました。 どうもありがとうございました。