- 締切済み
ExcelVBAでオートシェイプラインを変更したい
Excel2013を使用しています。表中の空欄にShapeを使って斜めにラインを引いていますが、この線をデータのカウントに合わせて上端を変化させたい。AddLineにて線を挿入するコードとマクロでのSelection.ShapeRange.ScaleWidth 1.3605442177, msoFalse, msoScaleFromBottomRight 'Selection.ShapeRange.ScaleHeight 0.7500001875, msoFalse, _では希望通りできますが、いちいちポイントをつかまなくてはなりません。名前を付けたラインをセレクトして「I27(右上)~B31(左下固定)」等と上端を変化できる方法を教えてください。
- みんなの回答 (2)
- 専門家の回答
みんなの回答
- WindFaller
- ベストアンサー率57% (465/803)
こんにちは。 返事が遅くなりました。 マクロ自体は早速作ってしまったのですが、オヤっと思って、確認の必要がありました。 そして、そのままになってしまい、申し訳ありません。 使い方としては、必要な場所を、まず範囲設定してから、以下のマクロの実行をすれば、前にあった罫線などは削除されて、新たに線を引きます。ポイント(角)という考え方ではなく、あくまでも、セル(連結を含む)部分の左下と右上を結ぶように出来ています。実務的には、右クリック・イベントに設けるのが一番便利かと思います。 '// Sub TestLine() Dim shp As Shape For Each shp In ActiveSheet.Shapes If Not Intersect(Selection, shp.TopLeftCell) Is Nothing Then shp.Delete End If Next Call SetLine(Selection) End Sub Function SetLine(rng As Range) Dim Lf As Double, Tp As Double, Wd As Double, Ht As Double Dim x1 As Double, y1 As Double, x2 As Double, y2 As Double With rng Lf = .Cells(1).Left Tp = .Cells(1).Top Wd = .Cells(1, .Columns.Count + 1).Left - .Cells(1).Left Ht = .Cells(.Rows.Count + 1, 1).Top - .Cells(1).Top End With x2 = Lf + Wd: y2 = Tp x1 = Lf: y1 = Tp + Ht With ActiveSheet.Shapes.AddLine(x1, y1, x2, y2).DrawingObject .ShapeRange.Fill.Visible = msoFalse .ShapeRange.Line.Weight = 0.75 .ShapeRange.Line.DashStyle = msoLineSolid .ShapeRange.Line.Style = msoLineSingle .ShapeRange.Line.Transparency = 0# End With End Function '//
- WindFaller
- ベストアンサー率57% (465/803)
こんにちは。 一度、マクロは考えたのですが、読みなおしてみると、こちらが勇み足になる可能性があったので、コードのアップは取りやめにしました。 >名前を付けたラインをセレクトして「I27(右上)~B31(左下固定)」等と上端を変化できる方法を教えてください。 「名前を付けたライン」とは、名前などを付けてしまったのでしょうか。 「I27(右上)~B31(左下固定)」とは、ひとつの範囲だけを指すとは思いにくいのですが。言い換えれば、汎用性がなくては、意味がないし、その範囲の元になるのは、四角形(rectangle)という意味ではないでしょうか。 「いちいちポイントをつかまなくてはなりません。」のポイントとは、表計算上にそのような部分が置かれているのでしょうか。一旦は、四角形の左下の角から右上の角を点と点を結ぶものと考えましたが、分からなくなりました。 その斜めに引いた線が、ずれているか、結果的にはずれてしまったと、当初は解釈しました。 しかし、図形(四角形など)内のライン(直線)は他の図形とConnectしていれば、図形の変化に対応するはずなので、ご質問の意味が分からなくなりました。
補足
windFallerさんご検討ありがとうございます。たとえば請求書の〆の線のように以下空白であれば左斜め下に向かってラインを引くことを想定しています。セル結合していますので罫線では解決できません。コードでAddLineを使い線を挿入することでは「角」をとらえて線を引くことができました。しかし、次は削除しないと追加されていくだけになります。また、ポイントは挿入→図形→直線からマクロを記録するとポイントでコードが記録されます。このポイントを変化させることで可能ですが大変です。わかりづらくて申し訳ありません。