| |
▼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
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 11/8/6(土) 9:23 -
