|
▼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
|
|