トリミングもどき

シートに写真を挿入して必要ない部分はトリミングという作業をする。
このトリミング作業のときに、オートシェイプ(四角)の枠線と同じサイズにするマクロを。
無理やり組んだ気がするし、糞の役にもたちそうにないが。
e0080122_22104124.gif

Option Explicit
Dim 写真top As Single, 写真left As Single, 写真width As Single, 写真height As Single
Dim ものさしtop As Single, ものさしleft As Single, ものさしwidth As Single, ものさしheight As Single
Dim mypic As Object
Dim ものさし As Shape

Sub 写真セット()
Dim myFname As String
 myFname = Application.GetOpenFilename(FileFilter:="すべての図(*.jpg),*.jpg")

On Error Resume Next
ActiveSheet.Shapes("写真").Delete
ActiveSheet.Shapes("ものさし").Delete

If myFname = "False" Then Exit Sub

  Set mypic = ActiveSheet.Pictures.Insert(myFname)
    With mypic
      .Name = "写真"
      .Top = 0
      .Left = 0
    End With
       Call ものさし表示
End Sub

Sub 偽トリミング()
Set mypic = ActiveSheet.Shapes("写真")
Set ものさし = ActiveSheet.Shapes("ものさし")
'本来以下はどうでもいいけど、頭が混乱しそうなので書いた
 写真top = mypic.Top
 ものさしtop = ものさし.Top
 写真height = mypic.Height
 ものさしheight = ものさし.Height
 写真left = mypic.Left
 ものさしleft = ものさし.Left
 写真width = mypic.Width
 ものさしwidth = ものさし.Width
’混乱を防ぐつもりがますます混乱してしまった。あとで作り直そう。

  With mypic
     With .PictureFormat
      .CropTop = ものさしtop - 写真top
      .CropBottom = (写真top + 写真height) - (ものさしtop + ものさしheight)
      .CropLeft = ものさしleft - 写真left
      .CropRight = (写真left + 写真width) - (ものさしleft + ものさしwidth)
    End With
   .Name = ActiveSheet.Pictures.Count
  End With
     ものさし.Delete
End Sub

Sub ものさし表示()
With ActiveSheet.Shapes.AddShape(msoShapeRectangle, 10, 10, 50, 50)
.Fill.Visible = msoFalse
.Line.Weight = 2.25
.Line.ForeColor.SchemeColor = 10
.Name = "ものさし"
.Select
End With
e0080122_22202769.gif

非常に無理やりだったが、目的のものが出来たのでまぁ良かった。
[PR]
by slayer0210 | 2005-12-08 22:23 | マクロ


<< 重複しないデータを数える 図形を動かす >>