| |
▼UO3 さん：
どうもありがとうございました。
先の方のご提案とあわせて組み合わせで作ってみます。
大量にデータ処理をする関係もありますので、
お教えいただいたプログラムをベースに
もう少しフローを詰めてみます。
でも、大きく前進できました。
本当にありがとうございました。
今後ともよろしくお願いいたします。
>▼takataka さん：
>
>こんにちは
>
>シート上の図をデータとして取り出す、あるいは保存する方法はかみちゃんさんからご紹介がありました。
>一方、図の縮小率（拡大率）について、興味がありましたので、オブジェクトブラウザで調べたり、
>図を変数に格納した上で、ローカルウィンドウで、その中身を調べたりしたのですが、率、あるいは
>元の図のサイズに関するプロパティは見当たりませんでsタ。で、ネットを検索してみますと、質問箱の
>過去ログがありました。
>www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=57952;id=excel
>
>これをベースにして、テストプロシジャを作ってみました。
>シート上の "Picture 1" という図にかんして倍率を表示し、メッセージに対して貼り付けOKなら
>そのときのアクティブセルの位置に、元の大きさで貼り付けます。
>
>なお、倍率は、本来は縦、横 それぞれ異なる可能性もありますが通常は縦横比率を維持しておられると
>思いますので「横」の倍率のみを表示しています。
>
>Sub Sample()
> Dim myW As Double, myH As Double, myRatio As Double
> Dim oW As Double, oH As Double
>
> Application.ScreenUpdating = False
> With ActiveSheet.Shapes("Picture 1")
> myW = .Width
> myH = .Height
> '図を元の大きさに変更
> .ScaleHeight 1, msoTrue
> .ScaleWidth 1, msoTrue
> oH = .Height
> oW = .Width
> .Copy
> '縮小後のサイズに戻す
> .Width = myW
> .Height = myH
> End With
> Application.ScreenUpdating = True
> myRatio = WorksheetFunction.Round(myW / oW * 100, 0)
> If MsgBox("縮小/拡大率は" & myRatio & "% です" & vbLf & _
> "アクティブセルの場所に貼り付けますか？", vbYesNo) = vbYes Then ActiveSheet.Paste
> Application.CutCopyMode = False
>
>End Sub
|
|
takataka
- 11/8/9(火) 19:03 -
