Excel VBA質問箱 IV

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

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


4573 / 13644 ツリー ←次へ | 前へ→

【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 発言[未読]

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

引用なし
パスワード
   エクセルのA列に画像ファイル名が書かれていて、A列に入力されている画像ファイル名に対応する画像ファイルをB列に繰り返し貼りつける処理を行いたいのですが、マクロでどのように書いたら良いのか分からず、質問させていただきました。

1つの行の高さ:120、幅:30と指定しています。
画像はセル内におさまるように、縮小又は拡大したいです。


よろしくお願いします。

【55809】Re:サイズが異なる画像の貼り付け
発言  kanabun  - 08/5/20(火) 11:14 -

引用なし
パスワード
   ▼mari さん:
こんにちは。
>エクセルのA列に画像ファイル名が書かれていて、
> 画像ファイル名に対応する画像ファイルをB列に繰り返し貼りつける処理

挿入メニュ−の[図の挿入][ファイルから...]
ファイル名を指定して画像を挿入する操作を マクロ記録してみるのが、
一番かと思います。
 ActiveSheet.Pictures.Insert ...
というような記録がとれると思います。


>1つの行の高さ:120、幅:30と指定しています。
>画像はセル内におさまるように、縮小又は拡大したいです。

挿入した画像の .Left を セルの.Left に、.Top をセルの .Top に、
画像の 横幅を セルの .Width に、
画像の 高さを セルの .Height に合わせればいいと思います。
ただ、
画像のたてよこ比(AspectRatio) が セルの たてよこ比と異なるばあいは
たても横もサイズ修正すると 元の画像が歪んでしまうので、
それがまずいばあいには たて方向または横方向 だけを セルに合わせる
ということになります。

【55812】Re:サイズが異なる画像の貼り付け
質問  mari  - 08/5/20(火) 11:55 -

引用なし
パスワード
   ▼kanabun さん:

ご回答ありがとうございます。
画像を貼りつけるマクロはこんな感じになるのでしょうか??

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


>1つの行の高さ:120、幅:30と指定しています。
>画像はセル内におさまるように、縮小又は拡大したいです。
すみません。。。
セルの高さ:120、幅:30(固定)として、そのセル内にサイズが異なる画像を貼り付けたいです。
ご享受お願いします。

【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

【55814】Re:サイズが異なる画像の貼り付け
発言  n  - 08/5/20(火) 12:53 -

引用なし
パスワード
   こんにちは。
>セルの高さ:120、幅:30(固定)として、そのセル内にサイズが異なる画像を貼り付けたいです。
縦横比は保持しますか?保持しませんか?
保持する場合は拡大|縮小率を考慮する必要がありますネ

【55819】Re:サイズが異なる画像の貼り付け
お礼  mari  - 08/5/20(火) 15:32 -

引用なし
パスワード
   ▼kanabun さん:

ご享受、ありがとうございます。
やってみます。

わからなければ、再度質問させていただきます。

【55866】Re:サイズが異なる画像の貼り付け
質問  mari  - 08/5/21(水) 15:11 -

引用なし
パスワード
   ▼n さん:
>こんにちは。
>>セルの高さ:120、幅:30(固定)として、そのセル内にサイズが異なる画像を貼り付けたいです。
>縦横比は保持しますか?保持しませんか?
>保持する場合は拡大|縮小率を考慮する必要がありますネ

▼n さん:
こんにちは。
縦横比を保持した状態で、セル内に貼りつけるにはどうしたら
良いでしょうか?
ご享受お願いいたします。

現在のプログラムだと、縦横比が変わってしまいます。。。↓

With .Pictures.Insert(画像ファイル名)
 .Left = ActCell2.Left + 12
 .Top = ActCell2.Top + 12
 .ShapeRange.LockAspectRatio = msoTrue '縦横比を固定
 .Width = ActCell2.Width * 0.8  'ここで横方向サイズ変更
 .Height = ActCell2.Height * 0.8  'ここで縦方向サイズ変更
 .ShapeRange.AlternativeText = 画像ファイル名
 .Placement = xlMoveAndSize
 .PrintObject = True
End With

【55871】Re:サイズが異なる画像の貼り付け
発言  kanabun  - 08/5/21(水) 16:14 -

引用なし
パスワード
   ▼mari さん:
>縦横比を保持した状態で、セル内に貼りつけるにはどうしたら
>良いでしょうか?
>
>現在のプログラムだと、縦横比が変わってしまいます。。。↓

このスレッドの前の方で、
> 画像のたてよこ比(AspectRatio) が セルの たてよこ比と異なるばあいは
> たても横もサイズ修正すると 元の画像が歪んでしまうので、
> それがまずいばあいには たて方向または横方向 だけを セルに合わせる
> ということになります。

とコメントしましたが?

【55873】Re:サイズが異なる画像の貼り付け
発言  n  - 08/5/21(水) 16:49 -

引用なし
パスワード
   >.Left = ActCell2.Left + 12
この12というのがセル枠からのマージンだと解釈して、

Dim n As Single 'マージン用
Dim x As Double '比率。縦横どちらか小さい方

上記変数2つ追加し、

n = 12
>For Each Acell In .Range("A1", .Range("A65536").End(xlUp))
>:
With .Pictures.Insert(画像ファイル名)
  With .ShapeRange
    .LockAspectRatio = msoTrue
    .Left = ActCell2.Left + n
    .Top = ActCell2.Top + n
    x = Application.Min((ActCell2.Width - n * 2) / .Width _
             , (ActCell2.Height - n * 2) / .Height)
    'Width|Heightは.ShapeRangeに対して変更しないと _
     LockAspectRatioプロパティが効果ない...と思います
    .Height = .Height * x
    .AlternativeText = 画像ファイル名
  End With
  .Placement = xlMove
  .PrintObject = True
End With
>:


#余談:『享受』は違...

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