Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

12650 / 76734

←次へ　｜　前へ→


	【69601】Re:エクセルに貼りつけてある画像をコピーしたい

UO3 - 11/8/6(土) 18:07 -


	引用なし

	パスワード

▼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

5 hits

▼

【69598】エクセルに貼りつけてある画像をコピーしたい takataka 11/8/6(土) 7:47