[[20180323183709]]　『オートシェイプ内の背景の縦横比を元に戻す』（konMM）　ページの最後に飛ぶ

『オートシェイプ内の背景の縦横比を元に戻す』（konMM）

オートシェイプに写真を入れる際に，写真が横長の場合，幅が縮んで縦長になってしまいます。
エクセル上では，写真を選び，トリミングの中の「塗りつぶし」を選べば，
元の縦横比になります。

マクロの記録でも記録されないため，方法を誰か教えてください。

With Selection.ShapeRange.Fill

     .Visible = msoTrue
     .UserPicture "C:\picture.jpg"
     .TextureTile = msoFalse
     .RotateWithObject = msoTrue
End With

これに何かを足すか，あるいはその方法だけでも教えてください。

＜使用 Excel：Excel2013、使用 OS：Windows10 ＞

こんばんは　＾＾
あまりやったこと無いので間違っているかもですが。
ご呈示のコードで当方ではシェープにあわせて横長に表示されましたですよ。

With Selection.ShapeRange

    .ScaleWidth 1.0641762452, msoFalse, msoScaleFromTopLeft
    .ScaleHeight 1.0963301824, msoFalse, msoScaleFromTopLeft
End With
マクロ記録でサイズ変更。。。マウスでずりずり、やった結果です。
で設定は出来るようですよ。

わたしの勘違いぽいですね。
的外れでしたらご容赦ください。

Win10、2016　でした。使用ファイルは横長サイズのPNGです。
（隠居じーさん） 2018/03/23(金) 19:44

大変失礼いたしました
上記レス（隠居じーさん） 2018/03/23(金) 19:44
は取消、廃案でお願いいたします。
思った結果にはなりません。

<< _ _ >>

（隠居じーさん） 2018/03/23(金) 19:52

下記が参考になるかもしれません。
https://msdn.microsoft.com/ja-jp/vba/excel-vba/articles/shaperange-scalewidth-method-excel
では　＾＾；

（隠居じーさん） 2018/03/23(金) 19:59

隠居じーさん，ありがとうございます。
しかし，縦横比を指定するのではなく，本来の縦横比に表示させたいのです。
また，説明文で不足していましたが，正しくは，「オートシェイプに合わせて縦長になる」ということです。
もう少し調べてみます…
（konMM） 2018/03/23(金) 20:28

横から失礼。
＞オートシェイプに写真を入れる際に，写真が横長の場合，幅が縮んで縦長になってしまいます。
仕様のようですから致し方ないですね。
　
＞エクセル上では，写真を選び，トリミングの中の「塗りつぶし」を選べば，
＞元の縦横比になります。
それではその方法を採用したらどうですか？
どうしてもオートシェイプに入れないといけない事情がありますか？

（γ） 2018/03/23(金) 22:05

可能ならば，オートシェイプに入れたいのですが，
VBAでトリミングの「塗りつぶし」に該当するものが存在しないような気が…
それがあるなら知りたいのです。

なければ，違う手法を考えたいと思います。
その際は，違う質問を新たに立てさせていただきます。
（konMM） 2018/03/23(金) 22:28

＞本来の縦横比に表示させたい
のであれば、オートシェイプの大きさを調整するか、
塗りつぶしにある「引き延ばしのオプション」で調整するのでしょう。
人に尋ねるだけでなく、自分でも検討してください。
（γ） 2018/03/23(金) 22:55

 挿入する画像の縦横比に合わせて図形の方を補正する方法です。
 画像の縦横比を変えず、また図形の大きさも変えない(余白を残す)場合は
 もう一工夫必要になります。

 [考え方]
 (1) 挿入した図形の縦サイズを固定し、
 (2) 図形の横幅を挿入する画像の縦横比で拡縮し、
 (3) その後に図形一杯に画像を貼り付ける
 手順になっています。
 図形の方を補正してしまうのですが・・・、テストしてみてください。

 [操作の手順]
 (1) 挿入する図形を選択後にマクロを実行し、
 (2) エクスプローラーから挿入する画像を選択します。

 Sub Sample()
    Dim PicFile As String, P As Object
        PicFile = Application.GetOpenFilename()
        If PicFile = "False" Then Exit Sub
        Set P = LoadPicture(PicFile)
        ’図形の縦サイズを固定して横幅を変更
        With Selection
            .Height = .Height
            .Width = .Height * (P.Width / P.Height)
        End With
        ’図形一杯に画像を挿入(作成されていたマクロ)
        With Selection.ShapeRange.Fill
            .Visible = msoTrue
            .UserPicture PicFile
            .TextureTile = msoFalse
            .RotateWithObject = msoTrue
        End With
    'http://officetanaka.net/excel/vba/tips/tips87.htm
 End Sub
（ NN ） 2018/03/24(土) 02:48

みなさん，ありがとうございます。
図形の大きさにトリミングすることが目的なので，
図形の大きさを変えることはできないんです…

調べてもなかなか解決策が見つからず，もう少し検討してみます。
（konMM） 2018/03/24(土) 09:14

コメント返信：

[ 一覧(最新更新順) ]

[[20180323183709]] 『オートシェイプ内の背景の縦横比を元に戻す』（konMM） ページの最後に飛ぶ

[[20180323183709]]　『オートシェイプ内の背景の縦横比を元に戻す』（konMM）　ページの最後に飛ぶ