• 締切済み

エクセルの図形(線)の情報

シート内に作図されている線の情報を調べるにはどうすればいいのでしょうか? 下記のX1~Y2の値が知りたいのですが。 ActiveSheet.Shapes.AddLine(X1, Y1, X2, Y2).Select あくまでも既に存在している線が対象です。 よろしくお願いします。

みんなの回答

  • zap35
  • ベストアンサー率44% (1383/3079)
回答No.1

そのshapeのtop、left、height、widthプロパティで知ることができます。 例えば ActiveSheet.Shapes.AddLine(10, 20, 150, 100).Select で描画した線のプロパティ値は left:9.75 top:20.25 width:140.25 height:79.9 と表示されます。始点が(9.75,20.25)、終点は(150,100.15)となる計算でしょう。 shape名はワークシート上で「新しいマクロを記録」にして、その線をセレクトすればモジュールシートに書き込まれます。 後はイミディエイトウィンドウで ?ActiveSheet.Shapes("shape名").width のように聞いてやればいいでしょう

chamire
質問者

お礼

ありがとうございます。

関連するQ&A

  • Excel VBA で自在に図形を変化させたい

    Excel VBAを使って図形を自由に変化させたいと思っています。 一つの形の四角形や三角形をVBAを使ってシート上に表記することは出来ます。 私はユーザーインターフェースを作り、テキストボックスに値を入れることで図形を変化させることをしたいと思っています。 例えば、一つの三角形を正三角形にしたり、直角二等辺三角形にしたり、自在に角度を変えてVBAに描かせたいと思っています。 三角形は以下のようにコードを記述しましたらシートに表示できました。 Sub 三角形作成() Set ArwLine = ActiveSheet.Shapes.AddLine(10, 10, 200, 200) Set ArwLine = ActiveSheet.Shapes.AddLine(200, 200, 100, 400) Set ArwLine = ActiveSheet.Shapes.AddLine(100, 400, 10, 10) End Sub これを以下のようにして変数(x、y)にユーザーインターファースから値を代入するようにしたいのですがどのようにすればよいのでしょうか教えてください。 Private Sub CommandButton1_Click() UserForm1.Show End Sub Sub 三角形作成() Set ArwLine = ActiveSheet.Shapes.AddLine(10, 10, 200, 200) Set ArwLine = ActiveSheet.Shapes.AddLine(200, 200, x, y) Set ArwLine = ActiveSheet.Shapes.AddLine(x, y, 10, 10) End Sub 前回、「Excel VBAで図面を書きたい」という質問をしたのですがややこしく書いたため解答される方が居ませんでしたので編集して再質問をさせていただきます。 よろしくお願いします。

  • エクセルで簡単なオートシェイプのマクロをつくりました マクロの実行とステップごとの実行の結果がちがってしまいます

    オートシェイプを使った簡単な寸法線の入った図をマクロで書きました。 ステップごとだと期待どおりのアウトプットなのですが、ダイレクトにマクロを実行すると途中のステップがとんでしまうようです。 どうしてでしょうか。 教えてください。 1 Sub 寸法線1() 2 Dim l1, l2, l3, l4, lb, la1, la2, fig1, fig2, fig3, fig4 As Shape 3 x1 = 200 4 y1 = 500 5 x2 = x1 + 100 6 k = Cells(7, 5).Value / Cells(7, 4).Value 7 y2 = y1 - 100 * k 8 Set l1 = ActiveSheet.Shapes.AddLine(x1, y1, x2 + 20, y1) 9 Set l2 = ActiveSheet.Shapes.AddLine(x1, y1, x1, y2 - 15) 10 Set lb = ActiveSheet.Shapes.AddLine(x1, y1, x2, y2) lb.Line.Weight = 2# 11 Set l3 = ActiveSheet.Shapes.AddLine(x2 + 5, y2, x2 + 20, y2) 12 Set l4 = ActiveSheet.Shapes.AddLine(x2, y2 - 5, x2, y2 - 15) 13 Set la1 = ActiveSheet.Shapes.AddLine(x2 + 12.5, y1 - 2, x2 + 12.5, y2 + 2) 14 la1.Line.BeginArrowheadStyle = msoArrowheadTriangle 15 la1.Line.BeginArrowheadLength = msoArrowheadLengthMedium 16 la1.Line.BeginArrowheadWidth = msoArrowheadWidthMedium 17 la1.Line.EndArrowheadStyle = msoArrowheadTriangle 18 la1.Line.EndArrowheadLength = msoArrowheadLengthMedium 19 la1.Line.EndArrowheadWidth = msoArrowheadWidthMedium 20 Set la2 = ActiveSheet.Shapes.AddLine(x1 + 2, y2 - 10, x2 - 2, y2 - 10) 21 la2.Line.BeginArrowheadStyle = msoArrowheadTriangle 22 la2.Line.BeginArrowheadLength = msoArrowheadLengthMedium 23 la2.Line.BeginArrowheadWidth = msoArrowheadWidthMedium 24 la2.Line.EndArrowheadStyle = msoArrowheadTriangle 25 la2.Line.EndArrowheadLength = msoArrowheadLengthMedium 26 la2.Line.EndArrowheadWidth = msoArrowheadWidthMedium 27 Set fig1 = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _ x1 - 10, y1 + 5, 17, 17) 28 fig1.Select 29 Selection.Characters.Text = Str(Cells(6, 3)) 30 Selection.Characters.Font.Bold = True 31 Selection.ShapeRange.Line.Visible = msoFalse 32 Set fig2 = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _ x2 + 5, y2 - 20, 18, 18) 33 fig2.Select 34 Selection.Characters.Text = Str(Cells(7, 3)) 35 Selection.Characters.Font.Bold = True 36 Selection.ShapeRange.Line.Visible = msoFalse 37 Set fig3 = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, _ x1 + (x2 - x1) * 0.5 - 13, y2 - 32, 45, 17) 38 fig3.Select 39 Selection.Characters.Text = Str(Cells(7, 4)) 40 Selection.ShapeRange.Line.Visible = msoFalse 41 Set fig4 = ActiveSheet.Shapes.AddTextbox(msoTextOrientationUpward, _ x2 + 15, y1 - 0.5 * (y1 - y2) - 8, 17, 45) 42 fig4.Select 43 Selection.Characters.Text = Str(Cells(7, 5)) 44 Selection.ShapeRange.Line.Visible = msoFalse 45 MsgBox "pause" 46 Call l1.Select 47 Call l2.Select(False) 48 Call l3.Select(False) 49 Call l4.Select(False) 50 Call lb.Select(False) 51 Call la1.Select(False) 52 Call la2.Select(False) 53 Call fig1.Select(False) 54 Call fig2.Select(False) 55 Call fig3.Select(False) 56 Call fig4.Select(False) 57 MsgBox "hit any" 58 Selection.ShapeRange.Group.Delete 59 End Sub Cells(7, 5)=50 cells(7,4)=100 cells(6,3)=1 cells(7,3)=2 です。 左端に行番号をふってあります。 36から44まで飛んでしまいます。 節点 座標 X Y 1 0 0 2 100 50

  • 引いた線をまとめて消したい。

    ActiveSheet.Shapes.AddLine(fromx, fromy, endx, endy).Select 上記で引いた線が何本か在ります。 コレを一つずつ選択せずにいっきに消す方法はないでしょうか。 宜しくお願いします。

  • EXCEL VBA で自在に図形を変化させたい(2)

    前回,質問させてもらい、非常に役に立つ回答をもらい解決しました。 今回、いろいろ本を見ても解決できない問題がありましたので再度質問をします。 EXCEL上にコマンドボタンを一つ配置します。右クリック→プロパティ→オブジェクト名をCmd作図に変更しておきます。 デザインモードでボタンをダブルクリックしてVBEでコード表示にします。 Private Sub Cmd作図_Click() ActiveSheet.Shapes.AddLine 200, 200, 400, 400 End Sub これでEXCEL上のコマンドボタンを押すと直線が作図できます。 次にAddLine以下の数字を変えて再度実行しますと別の直線がかけるのですが最初の直線が残ったままですので重なったりします。 前回、回答では Private Sub Cmd作図_Click() With ActiveSheet For Each Sh In .Shapes Sh.Delete Next Sh ActiveSheet.Shapes.AddLine 200, 200, 400, 400 End With End Sub という回答をもらっています。こうすれば前回描いた線を消してから作図できます。 しかし、前回は「マクロの実行」ボタンからの作図でしたので問題にはならなかったのですが、今回、EXCEL上にコマンドボタンを配置したところ、コマンドボタンもShapesと認識してしまうらしく、線と一緒に消されてしまいます。 この問題を解決できるコードを教えてもらいたいのですが。 よろしくお願いします。

  • エクセルで線の太さと色を変えるマクロ

    マクロ初心者です。ご教示願います。 エクセルのマクロで選択した任意のセルに●→を引くマクロを組みましたが、 線の太さと、色を変えるコードをどこにどう入れたらいのか教えてください。 Sub 線を引く() Dim TP, LF, WD TP = Selection.Top + (Selection.Height / 2) LF = Selection.Left WD = Selection.Width ActiveSheet.Shapes.AddShape(msoShapeOval, LF, TP - 3, 6, 6).Select ActiveSheet.Shapes.AddLine(LF + 6, TP, LF + WD, TP).Select

  • エクセルで線をセレクト

    アクティブシート内の全ての線(オブジェクト)をセレクト状態にするマクロを教えて頂けますでしょうか。 ちなみに、 ActiveSheet.Shapes.Line.SelectAll ではダメでした。

  • VBA のAddlineで引いた線を削除したい。

    Chart上にAddlineした直線が消せません。 あるイベントで ActiveChart.Shapes.AddLine(Xp1, Yline, Xp2, Yline).Select Selection.ShapeRange.Line.DashStyle = msoLineDash Selection.Name = "SUB_LINE" この時Chart上にはラインが引かれ名称が付けられています 又違うイベントで ActiveSheet.Shapes("SUB_LINE").Selectや Shapes("SUB_LINE").Delete として先ほど引いたLineを消去したいのですが Deleteの結果特にエラーも出ず、削除できません ツールを使って書いたLineは For Each SerchCShp In ActiveSheet.Shapes next の中で削除できたりするのですが 同じようにコーディングしても消えてくれません。  AddlineでChartに書き込んだLineを消去する方法を 教えてください。 Chartの補助線等は別の機能で使用しているので 使えずAddlineで線を引くしかないと言う状況で 引いた線を消したいのは引きなおしさせるためです WindowsXp+Office2003のExcel VBAを使用しています。

  • エクセル マクロで引いた線の色設定が戻せない

    エクセルで作成した、出席簿にマクロで 土日などに赤線で罫線の間に縦に オートシェィプ直線を引いています。 次に転出者の欄には、横に線をマクロで引いていますが 色が変えられません。 マクロ終了後もオートシェイプの線色は黒でも 、線を引くと赤のままです。 その線を選択して、色を変えないと 変えられない状態です。 マクロ終了前に、色をリセットする事は出来ませんか? 下記の内容がマクロの一部です。 よろしくお願いします。 If yobi = doyo Or yobi = niti Then Cells(3, 2 + n).Activate If yobi = niti Then With Selection.Font .ColorIndex = 3 End With End If ActiveSheet.Shapes.AddLine(110.25 + 21.75 * (n - 1), 42, 110.25 + 21.75 * (n - 1), 651).Select Selection.ShapeRange.Line.ForeColor.SchemeColor = 10 '10=赤色 End If If yobi = "" Then ActiveSheet.Shapes.AddLine(110.25 + 21.75 * (n - 1), 14.25, 110.25 + 21.75 * (n - 1), 651).Select Selection.ShapeRange.Line.ForeColor.SchemeColor = 8 '8=黒色 End If

  • エクセルで図形の削除

    シート内に作図されている線で、 100 < .Height < 200 And 100 < .Width < 200 上記の条件を満たすものを削除したいのですが、以下のマクロですと、全ての線が削除されてしまいます。 シート内に様々な長さ・向きの線を作図して試したのですが。 For Each x In ActiveSheet.DrawingObjects  With x    If 100 < .Height < 200 And 100 < .Width < 200 Then    .Delete    End If  End With Next どこがおかしいでしょうか? ご指摘お願いします。

  • 描画した Line 番号の取得方法

    描画した Line 番号の取得方法 VB6 Excel,2000 線をVBで2本引き、その線をグループ化させようと考えています。 下記コードの Range(Array("LIne " & 線A, "LIne " & 線B))に 2本引いた線の番号を入れたいのですが引いた線のLine番号を 取得する方法が分かりません、宜しくお願いします。 Dim xlApp As Excel.Application Set xlApp = GetObject(, "Excel.Application") xlApp.ActiveSheet.Shapes.AddLine 50, 50, 100, 100 '線A xlApp.ActiveSheet.Shapes.AddLine 100, 50, 50, 100 '線B xlApp.ActiveSheet.Shapes.Range(Array("LIne " & 線A, "LIne " & 線B)).Select xlApp.Selection.ShapeRange.Group.Select Set xlApp = Nothing

専門家に質問してみよう