Excel VBA質問箱 IV

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

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


60974 / 76738 ←次へ | 前へ→

【20391】Re:オートシェイプに接続点を追加する
発言  ichinose  - 04/12/8(水) 0:37 -

引用なし
パスワード
   pitakon さん、IROC さん、こんばんは。

>オートシェイプの円に直線コネクタを接続すると、円の周囲の8点に接続されます。
>円の周囲でなく円の中心に接続したいのですが、いい方法はないでしょうか?
>円のプロパティを変えるとか、新規にオートシェイプを定義するとか、なにか方法がありそうですが・・・。
>なお、わたくしの使用しているのはEXCEL97です。最新のバージョンで可能ならばその方法を教えてください。
>よろしくお願いします。
円とその中心を始点にした直線をグループ化してその直線にコネクターを接続する方法
です。
[#20349]と同じように二つの円を選択した状態で実行してみて下さい。

'=================================================================
Sub main()
  Dim x(1 To 2) As Single
  Dim y(1 To 2) As Single
  Dim ln(1 To 2) As Shape
  Dim con As Shape
  Dim shp As Shape
  Dim selshp As ShapeRange
  Set selshp = Selection.ShapeRange
  idx = 0
  For Each shp In selshp
   With shp
    x(idx + 1) = .Left + .Width / 2
    y(idx + 1) = .Top + .Height / 2
    With ActiveSheet
     Set ln(idx + 1) = .Shapes.AddLine(x(idx + 1), y(idx + 1), x(idx + 1), shp.Top)
     Set newshp = .Shapes.Range(Array(shp.Name, ln(idx + 1).Name)).Group
     End With
    idx = idx + 1
    End With
   Next
  Set con = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, x(1), y(1), x(2), y(2))
  With con.ConnectorFormat
    .BeginConnect ln(1), 1
    .EndConnect ln(2), 1
    End With
  For idx = 1 To 2
    ln(idx).Visible = msoFalse
    Next
  Erase x(), y(), ln()
End Sub

0 hits

【20383】オートシェイプに接続点を追加する pitakon 04/12/7(火) 19:38 質問
【20384】Re:オートシェイプに接続点を追加する IROC 04/12/7(火) 20:14 回答
【20391】Re:オートシェイプに接続点を追加する ichinose 04/12/8(水) 0:37 発言
【20393】Re:オートシェイプに接続点を追加する 訂正 ichinose 04/12/8(水) 8:20 発言

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