Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 10全般 : Excel 2016)
シートに挿入した写真の拡大率を得て、縦横の拡大率を設定したい。
投稿日時: 18/09/09 13:49:55
投稿者: tllsp

他の端末で作成したシート上の写真やシェイブの縦横の拡大率が変わってしまうため、選択されているオブジェクトの縦横の拡大率を取得し、小さいほうへ合わせるマクロを作成したいのですが、うまくゆきません。
 
仕方なく、入力してその値を設定するようにしています。
【コード例】
Dim k As Long
Dim tmp
Dim msg As String
msg = "拡大率を入力してください。" & vbCrLf & vbCrLf
msg = ms & "左右の拡大率が同じ値となります。"
tmp = InputBox(prompt:=msg, Title:="拡大率設定", Default:=1)
     
    If tmp = "" Then Exit Sub
    Selection.ShapeRange.ScaleWidth tmp, msoTrue
    Selection.ShapeRange.ScaleHeight tmp, msoTrue
Exit Sub
 
EXCEL仙人の皆さま、お知恵を拝借させてください。

回答
投稿日時: 18/09/09 14:36:24
投稿者: WinArrow
投稿者のウェブサイトに移動

 
 
 
拡大率というプロパティは、見当たらないので
  
図形を複写して
現在のサイズを取得し
 その図形を100%に変更したサイズを取得して比率を求めればよいのでは?
 複写後図形は作業用なので、用済後は削除します。
  
参考コード
Sub test()
 Dim shape As shape
 Dim H As Single, R As Single
   
     Set shape = ActiveSheet.Shapes(1)
       
     With shape.Duplicate
         H = .Height
         .ScaleHeight 1, True '100%に変更
        R = H / .Height * 100
         .Delete
     End With
     Debug.Print R
   
 End Sub
 

投稿日時: 18/09/09 16:18:05
投稿者: tllsp

ありがとうございます。やっぱりワークで貼り付けて。。。ぐらいでしょうか、投稿からも続けて検索しましたが、ScaleWidthやScaleHeightの現状の値を取得する方法がわかりませんでした。
 
EXCELの作成したバージョンやOSのバージョンによって、挿入した写真や図形の縦横の比率が勝手に変わってしまい、再現性がなくなっているので、なんとかアドインに組み込んで解決しようとしていました。
^^;
ありがとうございます。
 
ご提案の方法で組み込んでみます。m(_ _)mぺこり

トピックに返信