□ 戻る □一般操作のサロン □ 使用方法 □ 新着記事 □ 新規に質問する！ □ トピック一覧 □ 検索 □ 過去ログ
[ 最新記事及び返信フォームをトピックトップへ ]
| セルを跨いで太い直線を引きたい | |
|---|---|
[194721] セルを跨いで太い直線を引きたい- ■親トピック/記事引用/メール受信=OFF■ □投稿者/ 吉田 -(2022/02/08(11:10)) □U R L/ セルを跨いで太い直線を引きたく調べています。 マクロ記録を取ったところ、 ActiveSheet.Shapes.AddLine(108#, 40.5, 162#, 81#).Select の如くに出て普通の太さの線が引けましたが、 この108#だとか、40.5の意味が分かりません。 多分実際の位置なのかと思いますが。 また、 Range("B2").Borders(xlDiagonalUp).LineStyle = True で、一つのセルの中なら引けることも分かりましたが、 これではセルが跨げません。 実際にやりたいのは、 （例えばですが） セルB2の左上の角からセルB7の右下の角までです。 言ってみれば、セルB2:B7を結合したかのような扱いです。 実際に結合してみたらできましたが、 結合せずにできればと思います。 以上、ポイントをまとめると以下の通りです。 ①セルを結合せずに、 ②色々な角から角へ、 ③太い直線を引く です。 excel2003 です。 宜しくお願いします。 ++++++++++++++++++++ OS ⇒OTHER Version⇒Excel 2003 ++++++++++++++++++++ | |
[194722] Re[1]: セルを跨いで太い直線を引きたい- ■記事引用/メール受信=OFF■ □投稿者/ *** -(2022/02/08(12:30)) □U R L/ 以下で、どうでしょう？
DrawLineの第1引数に始点のセルアドレス、
第2引数に終点のセルアドレス、
第3引数に線の太さ（ポイント単位）
を指定してみてください。
Excel2007で確認しました。
Sub test()
DrawLine Range("A1"), Range("A4") 'A1からA4まで既定の太さ
DrawLine Range("B1"), Range("B4"), 3 'B1からB4まで太線
End Sub
Sub DrawLine(ByVal r1 As Range, ByVal r2 As Range, Optional w As Single = 0.75)
Dim x1 As Single, y1 As Single, x2 As Single, y2 As Single
x1 = r1.Left: y1 = r1.Top
x2 = r2.Left + r2.Width: y2 = r2.Top + r2.Height
With r1.Parent.Shapes.AddLine(x1, y1, x2, y2).Line
.Weight = w
End With
End Subこの記事にはVBAのコードが含まれています。 緑の太文字→注釈 茶色の太文字→条件分岐 赤の太文字→ループ 青の太文字→その他 | |
[194723] Re[2]: セルを跨いで太い直線を引きたい- ■記事引用/メール受信=OFF■ □投稿者/ *** -(2022/02/08(12:33)) □U R L/ あ、訂正 DrawLineの第1引数に始点のRangeオジェジェクト、 第2引数に終点のRangeオジェジェクト です。 | |
[194724] Re[3]: セルを跨いで太い直線を引きたい- ■  / 記事引用/メール受信=OFF■
□投稿者/ 吉田 -(2022/02/08(13:41)) □U R L/ ***様、早速ありがとうございました。 出来ました。 left top width height の4つで角が表せるのですね。 太さも思いの通りです。 お世話になりました。 | |
[194726] Re[4]: セルを跨いで太い直線を引きたい- ■記事引用/メール受信=OFF■ □投稿者/ *** -(2022/02/08(14:25)) □U R L/ おまけ。線色を指定可能バージョン
Sub test()
DrawLine Range("A1"), Range("A4") '既定の太さ,既定の色
DrawLine Range("B1"), Range("B4"), 3 '太線,既定の色
DrawLine Range("C1"), Range("C4"), 5, vbRed '太線,指定色
DrawLine Range("D1"), Range("D4"), 5, RGB(0, 0, 255) '太線,RGB指定色
End Sub
Sub DrawLine(ByVal r1 As Range, ByVal r2 As Range, _
Optional ByVal w As Single = 0.75, _
Optional ByVal color As Long = 12287562)
Dim x1 As Single, y1 As Single, x2 As Single, y2 As Single
x1 = r1.Left: y1 = r1.Top
x2 = r2.Left + r2.Width: y2 = r2.Top + r2.Height
With r1.Parent.Shapes.AddLine(x1, y1, x2, y2).Line
.Weight = w
.ForeColor.RGB = color
End With
End Subこの記事にはVBAのコードが含まれています。 緑の太文字→注釈 茶色の太文字→条件分岐 赤の太文字→ループ 青の太文字→その他 | |
[194730] Re[5]: セルを跨いで太い直線を引きたい- ■ / 記事引用/メール受信=OFF■
□投稿者/ 吉田 -(2022/02/09(09:15)) □U R L/ ***様、追加までありがとうございます。 色指定、今回は使いませんが、了解です。 お世話になりました。 | |
[194731] Re[6]: セルを跨いで太い直線を引きたい- ■記事引用/メール受信=OFF■ □投稿者/ *** -(2022/02/09(13:26)) □U R L/ 後から、気づいたのですが....
DrawLine Range("A4"), Range("A1")のように
始点＝＞終点が左上から右下になっていない場合、前回の計算式では誤った座標を算出する為、DrawLine Range("A1:A4")のようにセル範囲をまとめて指定する方が良いと思いました。
後、少し追加で飛び値のセル範囲にも対応するようにしました。
修正版を置いておきます。
特に問題なければ、お返事は不要です。
Sub test()
DrawLine Range("A1:A4,A6:A10") '既定の太さ,既定の色,飛び地
DrawLine Range("B4:B1"), 3 '太線,既定の色 セルを逆に指定してもOK
End Sub
'rng:セル範囲(飛び地対応) width:線の太さ（ポイント単位）color：線色
Sub DrawLine(ByVal rng As Range, Optional ByVal width As Single = 0.75, Optional ByVal color As Long = 12287562)
Dim r As Range
For Each r In rng.Areas
With r.Parent.Shapes.AddLine(r.Left, r.Top, r.Left + r.width, r.Top + r.Height).Line
.Weight = width
.ForeColor.RGB = color
End With
Next
End Sub
この記事にはVBAのコードが含まれています。 緑の太文字→注釈 茶色の太文字→条件分岐 赤の太文字→ループ 青の太文字→その他 | |