Excel VBA質問箱 IV

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

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


41050 / 76732 ←次へ | 前へ→

【40767】Re:線のトリムって出来ないでしょうか?...
発言  ichinose  - 06/7/23(日) 14:53 -

引用なし
パスワード
   ▼カド さん:
こんにちは。

>折角回答頂きましたが、任意の交わっている線をトリムできるマクロが
>出来たらいいなと思いましたが、教えていただいたものはちょっと
>違ってました。

>今回は断念します。
と仰っているのですが、トリミングでも出来ると思っていたので
投稿します。
トリミングするためには図として再作成しなければならないと思います。


新規ブックの標準モジュールに
'======================================================
Sub main()
  Dim ww As Double
  Dim wk As Double
  Dim ln1 As Shape
  Dim ln2 As Shape
  Dim trm As Double
  Dim shp As Shape
  With Range("f10:g16")
    ww = .Width
    Set ln1 = ActiveSheet.Shapes.AddLine(.Left, .Top, .Left + .Width, .Top + .height)
    Set ln2 = ActiveSheet.Shapes.AddLine(.Left, .Top + .height, .Left + .Width, .Top)
    DoEvents
    MsgBox "元になる二つの交差する直線"
   
    Set shp = cnv_pic(ln1, ln2)
    With shp
     wk = .Width - ww
     trm = (.Width - wk) / 2
     .PictureFormat.CropLeft = trm
     DoEvents
     MsgBox "<作成"
     .PictureFormat.CropLeft = 0
     .PictureFormat.CropRight = .Width - trm
     DoEvents
     MsgBox ">作成"
     End With
    End With
End Sub
'==================================================================
Function cnv_pic(shp1 As Shape, shp2 As Shape) As Shape
'指定されたShapeをグループ化し、図として再作成する
  Dim l As Double, t As Double
  Dim gshp As Shape
  Set gshp = shp1.Parent.Shapes.Range(Array(shp1.Name, shp2.Name)).Group
  l = gshp.Left
  t = gshp.Top
  gshp.CopyPicture Appearance:=xlScreen, Format:=xlPicture
  Set cnv_pic = shp1.Parent.Pictures.Paste.ShapeRange(1)
  With cnv_pic
    .Left = l
    .Top = t
    End With
  gshp.Delete
End Function

これで、mainを実行して確認してみて下さい

「<」と「>」を順にトリミングで作成しています。

最終的に作成された「>」の図も
「右クリック」---「図の書式設定」とクリックし、
「図」タブの「トリミング範囲」で設定することで別のトリミングも可能です。

試してみて下さい。

>また、貴殿のコードを改良する技量も持ち合わせておらず、

上記のコードだって恐らく変更しなければ
使えないと思います。
その時間が持てないのであれば、それは仕方ないですね!!
1 hits

【39378】線のトリムって出来ないでしょうか? カド 06/6/23(金) 8:24 質問
【39390】Re:線のトリムって出来ないでしょうか? ichinose 06/6/23(金) 10:05 発言
【39397】Re:線のトリムって出来ないでしょうか?... ichinose 06/6/23(金) 11:34 発言
【39400】Re:線のトリムって出来ないでしょうか?... ichinose 06/6/23(金) 12:38 発言
【40754】Re:線のトリムって出来ないでしょうか?... カド 06/7/22(土) 18:42 お礼
【40767】Re:線のトリムって出来ないでしょうか?... ichinose 06/7/23(日) 14:53 発言
【40821】Re:線のトリムって出来ないでしょうか?... カド 06/7/24(月) 19:21 お礼
【40832】Re:線のトリムって出来ないでしょうか?... ichinose 06/7/24(月) 22:44 発言
【40954】Re:線のトリムって出来ないでしょうか?... わいわい 06/7/26(水) 19:03 発言
【40968】Re:線のトリムって出来ないでしょうか?... わいわい 06/7/27(木) 9:12 発言

41050 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free