gooドクター有料プランが1ヶ月間無料!

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

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

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

「VBAエクセルに貼り付けた画像をセルにあ」の質問画像
gooドクター

A 回答 (2件)

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
    • good
    • 4
この回答へのお礼

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

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

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

こんばんは!



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

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
    • good
    • 1
この回答へのお礼

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

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

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

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

gooドクター

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング