以前にトリミングもどきでも紹介したが、今回はシートに写真を挿入し、その写真を2分割してみた。
コード的にはベタベタでもっとスッキリさせる必要もあるが・・・。あまり糞の役にも立ちそうにないのでこのままで実行させた。 Sub 分割() Dim mypic As Object, mypic1 As Shape, mypic2 As Shape Dim picW As Single, picBW As Single Dim myFname As String myFname = Application.GetOpenFilename(FileFilter:="すべての図(*.jpg),*.jpg") If myFname = "False" Then Exit Sub Set mypic = ActiveSheet.Pictures.Insert(myFname) picW = mypic.Width picBW = mypic.Width / 2 mypic.Copy ActiveSheet.Paste Selection.Name = "mypic1" Set mypic1 = ActiveSheet.Shapes("mypic1") With mypic1.PictureFormat .CropRight = picBW End With With mypic1 .Top = 20 .Left = 20 .IncrementRotation 350 End With ActiveSheet.Paste Selection.Name = "mypic2" Set mypic2 = ActiveSheet.Shapes("mypic2") With mypic2.PictureFormat .CropLeft = picBW End With With mypic2 .Top = 20 .Left = 20 + picBW + 10 .IncrementRotation 10 End With mypic.Delete ActiveSheet.Shapes.Range(Array("mypic1", "mypic2")).Group End Sub こうしてみると、Withをネストすればよかったが・・・かなりメチャクチャだ。 しかし目的のものが出来たのでよしとする。
by slayer0210
| 2006-01-12 08:49
| マクロ
|
カテゴリ
以前の記事
フォロー中のブログ
検索
最新のトラックバック
その他のジャンル
ファン
記事ランキング
ブログジャンル
画像一覧
|
ファン申請 |
||