A 回答 (2件)
- 最新から表示
- 回答順に表示
No.2
- 回答日時:
ActiveSheetの1、2番目のShapesを対象に処理するサンプル。
Sub try()
Dim x(1) As Single
Dim y(1) As Single
Dim z As Single
With ActiveSheet
With .Shapes(1)
x(0) = .Left + .Width / 2
y(0) = .Top - 100
y(1) = .Top + .Height
End With
With .Shapes(2)
x(1) = .Left + .Width / 2
z = .Top - 100
If z < y(0) Then y(0) = z
z = .Top + .Height
If z > y(1) Then y(1) = z
End With
With .Lines.Add(x(0), y(0), x(0), y(1))
.Border.LineStyle = msoLineSquareDot
With .ShapeRange.Duplicate
.Left = x(1)
.Top = y(0)
End With
End With
y(0) = y(0) + 50
With .Lines.Add(x(0), y(0), x(1), y(0))
.ArrowHeadStyle = xlDoubleClosed
z = .Width
End With
End With
MsgBox Application.Round(z * 3528 / 1000, 0)
End Sub
取り敢えずExcel2003環境にて動作確認してます。
No.1
- 回答日時:
とりあえず、シート上に図形が2つの条件で
Sub Macro1()
Dim Sh As Shape
i = 0
For Each Sh In ActiveSheet.Shapes
Ybottom = Sh.Top + Sh.Height
Ytop = 200
X = Sh.Left + Sh.Width / 2
If i - Int(i / 2) * 2 = 0 Then
X1 = X
Else
X2 = X
End If
ActiveSheet.Shapes.AddConnector(msoConnectorStraight, X, Ybottom, X, Ytop).Select
With Selection.ShapeRange.Line
.Visible = msoTrue
.Weight = 2.25
.DashStyle = msoLineDash
.ForeColor.RGB = RGB(0, 0, 0)
.Transparency = 0
End With
i = i + 1
Next
ActiveSheet.Shapes.AddConnector(msoConnectorStraight, X1, 250, X2, 250).Select
Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadOpen
Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadOpen
With Selection.ShapeRange.Line
.Visible = msoTrue
.Weight = 2.25
.ForeColor.RGB = RGB(0, 0, 0)
.Transparency = 0
End With
ActiveSheet.Shapes.AddShape(msoShapeRectangle, (X1 + X2) / 2 - 20, 220, 40, 20).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 255, 255)
.Transparency = 0
.Solid
End With
Selection.ShapeRange.Line.Visible = msoFalse
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = X2 - X1
Selection.ShapeRange.ShapeStyle = msoShapeStylePreset7
Selection.ShapeRange.Line.Visible = msoFalse
End Sub
線の高さや点線の長さはご自身で設定して決めてください。
(単位:mm)も難義な話ですので、実際に印刷してみて修正してください。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- その他(Microsoft Office) ワードのマクロについて教えてください。 1 2023/01/22 11:43
- Excel(エクセル) excelウェブサイト登録マクロ有効ブックにしないで済む方法 2 2023/08/05 20:26
- PowerPoint(パワーポイント) 2016EXCEL→2016PowerPointにコピペすると図形がゆがみます 5 2022/03/31 11:44
- Excel(エクセル) エクセルで同じ数字同士を自動で線で結ぶVBAを教えてください 6 2022/04/26 23:13
- Excel(エクセル) エクセルのマクロについて教えてください。 1 2023/01/11 11:47
- PowerPoint(パワーポイント) ExcelのVBAコードについて教えてください。 3 2022/05/25 14:32
- Visual Basic(VBA) Excelのマクロコードについて教えてください。 1 2022/06/19 10:08
- Excel(エクセル) Excelのマクロについて教えてください。 4 2022/05/31 14:07
- Excel(エクセル) エクセルのマクロについて教えてください。 1 2023/03/01 15:14
- Excel(エクセル) Excel VBAのことでお聞きしたいことがあり、ご教授お願いします。 下記の3つの図形があり、この 3 2022/08/08 17:57
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルで特定の列が0表示の場...
-
Excel マクロ VBA プロシー...
-
Excel・Word リサーチ機能を無...
-
メッセージボックスのOKボタ...
-
ExcelのVBA。public変数の値が...
-
一つのTeratermのマクロで複数...
-
特定のPCだけ動作しないVBAマク...
-
エクセルで別のセルにあるふり...
-
Excel VBAからAccessマクロを実...
-
ExcelVBAでPDFを閉じるソース
-
Excel2013 VBA マクロ実行中に...
-
エクセルに張り付けた写真のフ...
-
IF関数を使ってマクロを実行さ...
-
Excel 改ページのVBAうまくい...
-
エクセルのマクロについて教え...
-
ExcelVBA 図形をクリックした...
-
EXCELのVBAでRange("A1:C4")を...
-
Excelのマクロについて教えてく...
-
有効数字N桁のマクロについて
-
MSアクセスのマクロ・モジュー...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excel・Word リサーチ機能を無...
-
特定のPCだけ動作しないVBAマク...
-
エクセルで特定の列が0表示の場...
-
Excel マクロ VBA プロシー...
-
メッセージボックスのOKボタ...
-
一つのTeratermのマクロで複数...
-
エクセルで別のセルにあるふり...
-
ExcelのVBA。public変数の値が...
-
エクセルに張り付けた写真のフ...
-
ExcelVBAでPDFを閉じるソース
-
EXCELのVBAでRange("A1:C4")を...
-
Excel VBAからAccessマクロを実...
-
TERA TERMを隠す方法
-
エクセルのマクロについて教え...
-
エクセルのマクロについて教え...
-
エクセルのマクロについて教え...
-
エクセルのマクロについて教え...
-
マクロ実行時、ユーザーフォー...
-
Excelのマクロについて教えてく...
-
ソース内の行末に\\
おすすめ情報