Excel VBA質問箱 IV

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

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


26251 / 76732 ←次へ | 前へ→

【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
0 hits

【55805】サイズが異なる画像の貼り付け mari 08/5/20(火) 10:40 質問
【55809】Re:サイズが異なる画像の貼り付け kanabun 08/5/20(火) 11:14 発言
【55812】Re:サイズが異なる画像の貼り付け mari 08/5/20(火) 11:55 質問
【55813】Re:サイズが異なる画像の貼り付け kanabun 08/5/20(火) 12:10 回答
【55819】Re:サイズが異なる画像の貼り付け mari 08/5/20(火) 15:32 お礼
【55814】Re:サイズが異なる画像の貼り付け n 08/5/20(火) 12:53 発言
【55866】Re:サイズが異なる画像の貼り付け mari 08/5/21(水) 15:11 質問
【55871】Re:サイズが異なる画像の貼り付け kanabun 08/5/21(水) 16:14 発言
【55873】Re:サイズが異なる画像の貼り付け n 08/5/21(水) 16:49 発言

26251 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free