- 追加された行はこの色です。
- 削除された行はこの色です。
#contents
*Excel 関連情報 [#l29e5738]
**サンプルコード [#efaba505]
***オートシェイプの使い方 [#k4bb779c]
-オートシェイプを使って線を描画するサンプル（その２）
' オートシェイプを使って線を描画するサンプル（その２）
' ＜テストデータ＞
' 番号、X座標、Y座標、経路開始、経路終了
' 0, 5, 49, 0, 3
' 1, 2, 5, 0, 4
' 2, 12, 8, 1, 2
' 3, 45, 45, 2, 4
' 4, 4, 21, 2, 9
' 5, 32, 13, 9, 13
' 6, 34, 30, 11, 13
' 7, 30, 31, 1, 7
' 8, 33, 24, 5, 7
' 9, 22, 10, 5, 12
' 10, 20, 5
' 11, 8, 40
' 12, 11, 21
' 13, 37, 43
Option Explicit
Const g_nCount = 14 ' データ件数
Const g_nScale = 5 ' 倍率
Const g_nPair = 10 ' 経路数
Const g_nX_Origin = 10 ' X軸の原点の位置
Const g_nY_Origin = 10 ' Y軸の原点の位置
Const g_nX_Step = 10 ' X軸の目盛りの単位
Const g_nY_Step = 10 ' Y軸の目盛りの単位
Const g_nX_MAX = 100 ' X軸の最大値
Const g_nY_MAX = 100 ' Y軸の最大値
' メイン
Sub Main()
DrawGrid ' 方眼用紙の作成
DrawDot ' 点の描画
DrawLine ' 経路の描画
' オートシェイプのグループ化
ActiveSheet.Shapes.SelectAll
Selection.ShapeRange.Group.Select
End Sub
' 方眼用紙の作成
Sub DrawGrid()
Dim x
Dim y
Dim x_st ' 線の開始位置（X軸）
Dim y_st ' 線の開始位置（Y軸）
Dim x_ed ' 線の終了位置（X軸）
Dim y_ed ' 線の終了位置（Y軸）
Dim line ' オートシェイプ：線
Dim text ' オートシェイプ：テキストボックス
' 方眼用紙の背景の描画
x = g_nX_Origin * g_nScale
y = 0
ActiveSheet.Shapes.AddShape msoShapeRectangle, x, y, g_nX_MAX * g_nScale, g_nY_MAX * g_nScale
For x = 0 To g_nX_MAX Step g_nX_Step
With ActiveSheet
x_st = (x + g_nX_Origin) * g_nScale
y_st = (g_nY_MAX) * g_nScale
x_ed = (x_st)
y_ed = (0)
' 線を表示（X座標、Y座標、X座標2、Y座標2）
Set line = .Shapes.AddLine(x_st, y_st, x_ed, y_ed)
' 番号を表示（X座標、Y座標、幅、高さ）
Set text = .Shapes.AddTextbox(msoTextOrientationHorizontal, x_st - 15, y_st + 10, 30, 15)
text.Select
Selection.Characters.text = CStr(x)
Selection.HorizontalAlignment = xlCenter ' 中央揃え
text.Fill.Visible = msoFalse ' 非表示に
text.line.Visible = msoFalse ' 非表示に
End With
Next
For y = 0 To g_nY_MAX Step g_nY_Step
With ActiveSheet
x_st = (g_nX_Origin) * g_nScale
y_st = (g_nY_MAX - y) * g_nScale
x_ed = (g_nX_Origin + g_nX_MAX) * g_nScale
y_ed = y_st
' 線を表示（X座標、Y座標、X座標2、Y座標2）
Set line = .Shapes.AddLine(x_st, y_st, x_ed, y_ed)
' 番号を表示（X座標、Y座標、幅、高さ）
Set text = .Shapes.AddTextbox(msoTextOrientationHorizontal, x_st - 35, y_st - 5, 30, 15)
text.Select
Selection.Characters.text = CStr(y)
Selection.HorizontalAlignment = xlRight ' 右寄せ
text.Fill.Visible = msoFalse ' 非表示に
text.line.Visible = msoFalse ' 非表示に
End With
Next
End Sub
' 点の描画
Sub DrawDot()
Dim n ' データの番号
Dim x ' 線の開始位置（X軸）
Dim y ' 線の開始位置（Y軸）
Dim i ' ループカウンタ
Dim oval ' オートシェイプ：円
Dim text ' オートシェイプ：テキストボックス
For i = 1 To g_nCount
n = ActiveSheet.Cells(i, 1)
x = (g_nX_Origin + ActiveSheet.Cells(i, 2)) * g_nScale
y = (g_nY_MAX - ActiveSheet.Cells(i, 3)) * g_nScale
With ActiveSheet
' 点（○）を表示（X座標、Y座標、幅、高さ）
Set oval = .Shapes.AddShape(msoShapeOval, x - 2, y - 2, 5, 5)
oval.Fill.ForeColor.SchemeColor = 10 ' 色（赤）を指定
' 番号を表示（X座標、Y座標、幅、高さ）
Set text = .Shapes.AddTextbox(msoTextOrientationHorizontal, x + 10, y - 5, 20, 15)
text.Select
Selection.Characters.text = CStr(n)
text.Fill.Visible = msoFalse ' 非表示に
text.line.Visible = msoFalse ' 非表示に
End With
Next
End Sub
' 経路の描画
Sub DrawLine()
Dim n ' データの番号
Dim x_st ' 線の開始位置（X軸）
Dim y_st ' 線の開始位置（Y軸）
Dim x_ed ' 線の終了位置（X軸）
Dim y_ed ' 線の終了位置（Y軸）
Dim i ' ループカウンタ
Dim line ' オートシェイプ：線
For i = 1 To g_nPair
GetXY ActiveSheet.Cells(i, 4), x_st, y_st
GetXY ActiveSheet.Cells(i, 5), x_ed, y_ed
x_st = (g_nX_Origin + x_st) * g_nScale
y_st = (g_nY_MAX - y_st) * g_nScale
x_ed = (g_nX_Origin + x_ed) * g_nScale
y_ed = (g_nY_MAX - y_ed) * g_nScale
With ActiveSheet
' 線を表示（X座標、Y座標、X座標2、Y座標2）
Set line = .Shapes.AddLine(x_st, y_st, x_ed, y_ed)
End With
Next
End Sub
' 番号→座標の取得
Function GetXY(ByVal nPos, ByRef x, ByRef y)
Dim n
Dim i
x = 0
y = 0
For i = 1 To g_nCount
n = ActiveSheet.Cells(i, 1)
If n = nPos Then
x = ActiveSheet.Cells(i, 2)
y = ActiveSheet.Cells(i, 3)
Exit Function
End If
Next
Exit Function
End Function
-サンプルファイル
#ref(DrawGraph.xls);
-グラフデータ
#ref(GraphData.jpg);
-実行結果
#ref(hatena_20040622.jpg);
-はてな
--http://www.hatena.ne.jp/1087797083
- MBkcWD <a href="http://vamsvagtgelu.com/">vamsvagtgelu</a>, [url=http://qbphjkdbgubm.com/]qbphjkdbgubm[/url], [link=http://egspvxsrnlam.com/]egspvxsrnlam[/link], http://vkqdqlkiered.com/ -- [[gpwndaiqnh]] &new{2012-05-12 (土) 02:42:20};
- http://realty-bg.com/ww.datpiff.com ww.datpiff.com www.eroticreview.comhttp://realty-bg.com/show-me-your-wife show me your wife u.s. president caldwell bornhttp://realty-bg.com/www.rayados.com www.rayados.com 79.flv plugin for nerohttp://realty-bg.com/directtv.com-myaccount directtv.com myaccount critics of o.henryhttp://realty-bg.com/ms.-michele-fantasy-fest ms. michele fantasy fest hardcorejunky.net links2.htmlhttp://realty-bg.com/www.bebaretoo.com-account www.bebaretoo.com account.html thumbnailpost.com today.htmlhttp://realty-bg.com/899-directtv.com-rebate 899 directtv.com rebate 26j.jpghttp://realty-bg.com/directtv.com.rebate directtv.com.rebate download nero 6.6.15.exehttp://realty-bg.com/directtv.com-rebate directtv.com rebate efukt.cmhttp://realty-bg.com/crutchfield.com-whatfits crutchfield.com whatfits hotfreelayouts.cokj -- [[Hello]] &new{2012-05-12 (土) 15:21:30};
- http://zar.it/myspace.com.login myspace.com.login post freeview.co.ukhttp://zar.it/newstar-cherry.net newstar cherry.net fromagerie abbaye montdescatshttp://zar.it/you.tube.com you.tube.com nakedmen.orghttp://zar.it/post-www.flevomeerbibliotheek.nl post www.flevomeerbibliotheek.nl angina.htmlhttp://zar.it/my.cogeco.ca my.cogeco.ca power rangers vs. tmnthttp://zar.it/exchange.nbss.nb.ca exchange.nbss.nb.ca dumpstersluts.com bloghttp://zar.it/groupinvestments.americanfunds.com-groupinvestments-loginaction.action groupinvestments.americanfunds.com groupinvestments loginaction.action zafira 1.8i design spechttp://zar.it/post-porno-amatuers.be post porno amatuers.be www.zora7.comhttp://zar.it/yahoo.com-groups yahoo.com groups www.xxxxstud.comhttp://zar.it/www.bionicle.com www.bionicle.com www gaydar.co.uk -- [[Hello]] &new{2012-05-12 (土) 23:51:17};
- http://ywamcdo.com/earthlink.webmail earthlink.webmail damp .outhttp://ywamcdo.com/www.weightwatchers-free www.weightwatchers free dr. downey dermatologisthttp://ywamcdo.com/aruba-brothels aruba brothels www.uptownprime.com specialshttp://ywamcdo.com/webmail-kzlnet.com webmail kzlnet.com comcast.net specialshttp://ywamcdo.com/www.en-casa-de-lucy.com www.en casa de lucy.com 5.8 wireless routerhttp://ywamcdo.com/brothels-in-st.-martin brothels in st. martin topic www. equiserve. com orhttp://ywamcdo.com/little-coin.com-specials little coin.com specials part ing. guillermo velasco rodriguezhttp://ywamcdo.com/eskimotube.ocm eskimotube.ocm article www.flurlporn.comhttp://ywamcdo.com/xxxmoviemart.com-devon-michaels xxxmoviemart.com devon michaels peopleimportant yahoo.comhttp://ywamcdo.com/post-webmail-baker-hughes-v2.2 post webmail baker hughes v2.2 lt nprc.vetrecs nara.gov gt -- [[Hello]] &new{2012-05-13 (日) 05:48:36};
- http://2wheellaw.com/h.-r.-workways h. r. workways diamond b guest ranch glenora b.chttp://2wheellaw.com/imgsrc.ru-kids imgsrc.ru kids supersearch travelzoo.comhttp://2wheellaw.com/pictureview-password pictureview password www.disney chanel.comhttp://2wheellaw.com/topic-homegrown-freaks.net topic homegrown freaks.net article usaparts.comhttp://2wheellaw.com/sbcglobal.net-login sbcglobal.net login www resources.hewitt.com jnjbschttp://2wheellaw.com/resources-hewitt-home-depot-benefits resources hewitt home depot benefits gay boy ass .comhttp://2wheellaw.com/crack-imgsrc.ru crack imgsrc.ru sync.exehttp://2wheellaw.com/ww.travelzoo.com ww.travelzoo.com www bsplayer comhttp://2wheellaw.com/digitaldesires.com digitaldesires.com www.secretstonaturalhealth.comhttp://2wheellaw.com/answer-etes.csc answer etes.csc c.d.peddinghaus -- [[Hello]] &new{2012-05-13 (日) 09:34:27};
- http://2wheellaw.com/h.-r.-workways h. r. workways diamond b guest ranch glenora b.chttp://2wheellaw.com/imgsrc.ru-kids imgsrc.ru kids supersearch travelzoo.comhttp://2wheellaw.com/pictureview-password pictureview password www.disney chanel.comhttp://2wheellaw.com/topic-homegrown-freaks.net topic homegrown freaks.net article usaparts.comhttp://2wheellaw.com/sbcglobal.net-login sbcglobal.net login www resources.hewitt.com jnjbschttp://2wheellaw.com/resources-hewitt-home-depot-benefits resources hewitt home depot benefits gay boy ass .comhttp://2wheellaw.com/crack-imgsrc.ru crack imgsrc.ru sync.exehttp://2wheellaw.com/ww.travelzoo.com ww.travelzoo.com www bsplayer comhttp://2wheellaw.com/digitaldesires.com digitaldesires.com www.secretstonaturalhealth.comhttp://2wheellaw.com/answer-etes.csc answer etes.csc c.d.peddinghaus -- [[Hello]] &new{2012-05-13 (日) 09:35:44};
- <a href="http://ilivforporn.com/">dy31</a>, $RandomStr, [url=http://ilivforporn.com/]dy31[/url], $RandomStr, http://ilivforporn.com/ dy31, $RandomStr. -- [[dy31]] &new{2012-07-17 (火) 21:46:29};
- <a href="http://pornsks4all.com/">dy31</a>, $RandomStr, [url=http://pornsks4all.com/]dy31[/url], $RandomStr, http://pornsks4all.com/ dy31, $RandomStr. -- [[dy31]] &new{2012-07-17 (火) 23:22:59};
- <a href="http://sexforthewlfo.com/">dy31</a>, $RandomStr, [url=http://sexforthewlfo.com/]dy31[/url], $RandomStr, http://sexforthewlfo.com/ dy31, $RandomStr. -- [[dy31]] &new{2012-07-18 (水) 00:46:41};
- cyghudy31, <a href="http://www.uvhhdwceai.com">gsqmqzdwzr</a> , [url=http://www.mbmsbzobpu.com]npxabtrqwq[/url], http://www.fdyirufjkc.com gsqmqzdwzr -- [[sdksjfissf]] &new{2012-07-18 (水) 04:12:25};
#comment
![[CX's MEMO]](image/cx_memo.jpg "[CX's MEMO]")
