前回の作品で連続3回続けて写真貼り付けもいいが、セルを指定して一枚ずつ写真を貼り付ける方が自由度があってもいいかも
そこでアクティブセルへ一回限りの写真貼り付けへ改造した、office2007と2003でも確認済みよん
Sub アクティブセルへ写真貼り付け()
Dim vntFileName As Variant
Dim rng挿入先 As Range
Set rng挿入先 = ActiveCell
vntFileName = Application.GetOpenFilename( _
FileFilter:="写真 (*.bmp;*.jpg;*.tif;*.jpeg;*.png),*.bmp;*.jpg;*.tif;*.jpeg;*.png", _
Title:="挿入する写真を選択", MultiSelect:=False)
If VBA.VarType(vntFileName) <> vbString Then Exit Sub
With ActiveSheet.Pictures.Insert(vntFileName)
.Top = rng挿入先.Top
.Left = rng挿入先.Left
.Cut
rng挿入先.Select
' ActiveSheet.PasteSpecial Format:="図 (BMP)", Link:=False, DisplayAsIcon:=False
ActiveSheet.PasteSpecial Format:="図 (JPEG)", Link:=False, DisplayAsIcon:=False
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 252# 'DSC(Lサイズ相当) 89mm×119mm
Selection.ShapeRange.Width = 337.5 '
Application.CutCopyMode = False
Range("A1").Copy 'クリップボードの画像を消去する為の上書き・ダミーコピー
Application.CutCopyMode = False
End With
End Sub
pepoと
そこでアクティブセルへ一回限りの写真貼り付けへ改造した、office2007と2003でも確認済みよん
Sub アクティブセルへ写真貼り付け()
Dim vntFileName As Variant
Dim rng挿入先 As Range
Set rng挿入先 = ActiveCell
vntFileName = Application.GetOpenFilename( _
FileFilter:="写真 (*.bmp;*.jpg;*.tif;*.jpeg;*.png),*.bmp;*.jpg;*.tif;*.jpeg;*.png", _
Title:="挿入する写真を選択", MultiSelect:=False)
If VBA.VarType(vntFileName) <> vbString Then Exit Sub
With ActiveSheet.Pictures.Insert(vntFileName)
.Top = rng挿入先.Top
.Left = rng挿入先.Left
.Cut
rng挿入先.Select
' ActiveSheet.PasteSpecial Format:="図 (BMP)", Link:=False, DisplayAsIcon:=False
ActiveSheet.PasteSpecial Format:="図 (JPEG)", Link:=False, DisplayAsIcon:=False
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 252# 'DSC(Lサイズ相当) 89mm×119mm
Selection.ShapeRange.Width = 337.5 '
Application.CutCopyMode = False
Range("A1").Copy 'クリップボードの画像を消去する為の上書き・ダミーコピー
Application.CutCopyMode = False
End With
End Sub
pepoと