Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

26257 / 76738

←次へ　｜　前へ→


	【55813】Re:サイズが異なる画像の貼り付け

kanabun - 08/5/20(火) 12:10 -


	引用なし

	パスワード

▼mari さん：
>画像を貼りつけるマクロはこんな感じになるのでしょうか？？
>
>ActiveCell.Value="1.gif"
>ActiveSheet.Pictures.Insert("D:\" & ActiveCell.Value)
>With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
>　　.Left = ActiveCell.Offset(0, 1).Left
>　　.Top = ActiveCell.Offset(0, 1).Top
>End With

ですね。

A列をなめてすべてのファイルをB列に表示するとしたら、こんな感じです。

Sub A列のファイル名に対応する画像をB列にInsert() 'たてよこ比保持
　Dim 画像ファイル名 As String
　Dim Acell As Range　'A列
　Dim Bcell As Range　'B列
　
　With ActiveSheet
　　For Each Acell In .Range("A1", .Range("A65536").End(xlUp))
　　　　画像ファイル名 = "D:\" & Acell.Value
　　　　Set Bcell = Acell.Offset(, 1) 'B列
　　　　With .Pictures.Insert(画像ファイル名)
　　　　　　.Left = Bcell.Left
　　　　　　.Top = Bcell.Top
　　　　　　.ShapeRange.LockAspectRatio = msoTrue '縦横比を固定
　　　　　　.Width = Bcell.Width　　 'ここで横方向サイズ変更
　　　　　　.ShapeRange.AlternativeText = 画像ファイル名
　　　　End With
　　Next
　End With
End Sub

ただし、
>セルの高さ：120、幅：30（固定）として、そのセル内にサイズが異なる画像を貼り付けたいです。

ということでしたら、別のメソッド Shapes.AddPictureを使ったほうが楽でしょう。

Sub A列のファイル名に対応する画像をB列にAddPicture() '縦横比変形
　Dim 画像ファイル名 As String
　Dim Acell As Range　'A列
　Dim Bcell As Range　'B列
　
　With ActiveSheet
　　For Each Acell In .Range("A1", .Range("A65536").End(xlUp))
　　　　画像ファイル名 = "D:\" & Acell.Value
　　　　Set Bcell = Acell.Offset(, 1) 'B列
　　　　With .Shapes.AddPicture(画像ファイル名, _
　　　　　　msoFalse, msoTrue, _
　　　　　　 Bcell.Left, Bcell.Top, _
　　　　　　 Bcell.Width, Bcell.Height)
　　　　End With
　　Next
　End With
End Sub

1 hits

▼

【55805】サイズが異なる画像の貼り付け mari 08/5/20(火) 10:40