セルを跨いで太い直線を引きたい | |
---|---|
[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を結合したかのような扱いです。 実際に結合してみたらできましたが、 結合せずにできればと思います。 以上、ポイントをまとめると以下の通りです。 @セルを結合せずに、 A色々な角から角へ、 B太い直線を引く です。 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のコードが含まれています。 緑の太文字→注釈 茶色の太文字→条件分岐 赤の太文字→ループ 青の太文字→その他 |
このトピックに書きこむ |
---|