Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

42405 / 76732

←次へ　｜　前へ→


	【39397】Re:線のトリムって出来ないでしょうか？...

ichinose - 06/6/23(金) 11:34 -


	引用なし

	パスワード

関数内のコードはもっと簡単でした

>新規ブックの標準モジュールに
>'==============================================================
>Sub test()
>　　Dim rad As Double
>　　rad = WorksheetFunction.pi() / 4
>　　Call mk_hutougou([b5].Left, [b5].Top, 20, rad, , False)
>　　Call mk_hutougou([b5].Left, [b5].Top, 20, rad, , True)
>End Sub
>'=====================================================================

Function mk_hutougou(ByVal stx As Double, ByVal sty As Double, ByVal rs As Double, ByVal rad As Double, Optional ByVal sht As Worksheet = Nothing, Optional ByVal opn As Boolean = False) As Shape
　 '不等号を作成する
　 ' input stx 不等号始点となるLeft
　 '　　　 sty 不等号始点となるtop
　 '　　　 rs　半径距離
　 '　　　 rad 角度　Radian 0～π
　 '　　　 sht 作成するシート
　 '　　　 opn false 右開き　true 左開き
　 Dim pi As Double
　 Dim l1 As Line
　 Dim l2 As Line
　 pi = WorksheetFunction.pi()
　 If opn = True Then rad = 2 * pi - rad
　 If sht Is Nothing Then Set sht = ActiveSheet
　 Set l1 = sht.Lines.Add(stx, sty, stx + rs * Cos(rad / 2), sty + rs * Sin(-rad / 2))
　 Set l2 = sht.Lines.Add(stx, sty, stx + rs * Cos(rad / 2), sty + rs * Sin(rad / 2))
　 Set mk_hutougou = sht.Shapes.Range(Array(l1.Name, l2.Name)).Group
(l1.Name, l2.Name)).Group
>End Function

2 hits

▼

【39378】線のトリムって出来ないでしょうか？ カド 06/6/23(金) 8:24