VBAエクセルに貼り付けた画像をセルにあった大きさにしたい（等倍）

エクセル貼り付けた画像をセルにあった大きさにしたいのですが、
その際、縦と横の比率を変更したくありません。

縦と横の比率を変更せず、セルにおさまる最大の大きさで画像のサイズを
変えることは可能でしょうか。

-----------------------------------------------------------------------------
縦と横の比率が関係なく、セルいっぱいのサイズに画像の大きさを変更するVBAは
下記URLから見つけられたのですが、、、、、
http://q.hatena.ne.jp/1240648036

No.2 ベストアンサー 回答者： tom04 回答日時： 2015/04/14 19:43

No.1です。

＞画像が置いてあるセル上で処理を行う

画像のどこを基準にするか？によってコードは変わってきますが、
画像の左上端のセルにその画像を縦・もしくは横いっぱいに配置するコードにしてみました。

Sub Sample2()
Dim mySp As Shape, myRng As Range
Dim myHgt As Double, myWdt As Double

For Each mySp In ActiveSheet.Shapes
With mySp
Set myRng = .TopLeftCell
myHgt = myRng.Height
myWdt = myRng.Width
.Top = myRng.Top
.Left = myRng.Left
.Height = myHgt
If .Width > myWdt Then
.Width = myWdt
End If
End With
Next mySp
End Sub

こんな感じではどうでしょうか？m(_ _)m

この回答へのお礼

基点などの考えが及ばず申し訳ありません、
＞画像の左上端のセル
はい、こちらがやりたかったことでした！汲んで頂いて本当にありがとうございます！！

今までの作業がとても効率的になりますし、本当に嬉しいです！！！
ありがとうございました！！！！！神様です！！

お礼日時：2015/04/15 09:15

No.1 回答者： tom04 回答日時： 2015/04/13 20:29

こんばんは！

縦横固定は考えず、画像の縦・もしくは横がセルいっぱいに収まればよい！
という考え方のコードです。

A1セルからA列に順にセル内の収まるようにしてみました。
仮にアクティブSheet上に画像が5個あればA1～A5セル内に画像が収まるはずです。

Sub Sample1()
Dim cnt As Long, mySp As Shape
Dim myHgt As Double, myWdt As Double
Dim myRH As Double, myRW As Double
For Each mySp In ActiveSheet.Shapes
cnt = cnt + 1
myHgt = mySp.Height
myWdt = mySp.Width
myRH = Cells(cnt, "A").Height
myRW = Cells(cnt, "A").Width
With mySp
.Left = Cells(cnt, "A").Left
.Top = Cells(cnt, "A").Top
.Height = myRH '//一旦画像の高さをセルの高さに合わせる
'//▼　画像がセル幅より大きい場合はセル幅に合わせる
If .Width > myRW Then
.Width = myRW
End If
End With
Next mySp
End Sub

こんな感じではどうでしょうか？m(_ _)m

この回答へのお礼

ありがとうございます！！！
画像が奇麗なままでぴったりと収まりました！！

こちら、画像が置いてあるセル上で処理を行う（A列に並べない）場合は
どのようにすればよいでしょうか。説明が足りておらず申し訳ありません。。。

お礼日時：2015/04/14 09:32