任意の範囲に写真を挿入する

写真を挿入すると、サイズが大小様々だったり、また貼り付けられる位置も任意の場所には張り付かない。
そんな時の為に便利な(?)マクロを作ってみた。

Sub 任意の範囲に写真を挿入()
 Dim myFname As String
 Dim myrange As Range
 Dim 元図 As Object
   myFname = Application.GetOpenFilename(FileFilter:="すべての図(*.jpg),*.jpg")

    If myFname = "False" Then Exit Sub
   On Error GoTo erhand
    Set myrange = Application.InputBox("取り込み範囲をドラッグして下さい", "任意の範囲をドラッグ", Type:=8)
    Set 元図 = ActiveSheet.Pictures.Insert(myFname)
     With 元図
       .Height = myrange.Height
       .Width = myrange.Width
       .Top = myrange.Top
       .Left = myrange.Left
     End With
   Exit Sub
erhand: MsgBox "キャンセルしました"
End Sub
e0080122_1646598.gif

上図のようなダイアログが表示されるので、任意の場所をドラッグして取り込み場所などを入れる。
すると、ドラッグしたサイズと場所に写真が挿入される。
e0080122_16503951.gif

ただ、縦横の比率などは一切無視しているで妙な写真になることは確かだ。
他の人にとっては糞の役にも立ちそうにないが、目的のものが出来たのでよしとする。
[PR]
by slayer0210 | 2006-01-19 16:51 | マクロ


<< PRODUCT関数で積を求める 任意の数で写真を分割する >>