| |
>「写真のトリミン」で特に困っているわけではないんです。
そうでしたか。
一応、トリミング案としてはRectangleを使ってこんなイメージでした。
Sub try1()
If Application.Dialogs(xlDialogInsertPicture).Show = False Then Exit Sub
MsgBox "トリミング範囲ドラッグ後、写真クリック。"
Application.CommandBars.FindControl(ID:=1111).Execute
Selection.OnAction = "try2"
End Sub
Sub try2()
Dim sp As Shape
Dim pc As Picture
With ActiveSheet
Set pc = .Pictures(Application.Caller)
Set sp = .Shapes(.Shapes.Count)
If sp.Name <> pc.Name Then
With pc.ShapeRange.PictureFormat
.CropLeft = sp.Left - pc.Left
.CropTop = sp.Top - pc.Top
.CropRight = (pc.Left + pc.Width) - (sp.Left + sp.Width)
.CropBottom = (pc.Top + pc.Height) - (sp.Top + sp.Height)
End With
sp.Delete
End If
pc.OnAction = ""
'pc.CopyPicture appearance:=xlScreen, Format:=xlPicture
'.Paste pc.TopLeftCell
'pc.Delete
End With
Set pc = Nothing
Set sp = Nothing
End Sub
でもLindyさんの案が基本路線に沿ってるので良さそうですね。
何かの参考になれば幸いです。
|
|
n
- 07/11/26(月) 17:42 -
