![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?e8efa67)
Excel2003を使用しています。
複数行、複数列に渡って、斜線を引きたいのですが、例えば、始点をアクティブセルとして、終点のセルを選択して、そこに直線(斜線)を挿入するようなことは可能でしょうか?
列数は11列と定まっているのですが、行数がそのときどきで違うので、セルを選択する方法を例として書きましたが、何か別の方法でもいいので、アドバイスいただけると嬉しいです。
また、このようなサイズの定まっていないオートシェイプをマクロで挿入することは無理ならば、今までは手動で斜線のサイズ調整等をしていますので、可能か不可能かだけでもわかると助かります。
よろしくお願いします。
No.3ベストアンサー
- 回答日時:
こんばんは。
このマクロは、実践では意外に難しいです。コードの構造はすごく単純なのですが、オートシェイプは、不明な誤動作が多いということです。ここでも、見えなくなるとかトラブルが出ています。何年もの間、失敗の連続から生まれたコードですが、自信はありません。
不明なトラブルは、だいたい、1,000回を過ぎるころからです。そのために、コードは補填しています。
その点で、#1さんの罫線側は、そのような報告は皆無です。
'Option Explicit
'標準モジュール
Sub LineDrawing()
Dim r1 As Range
Dim r2 As Range
Dim x1 As Double, y1 As Double, x2 As Double, y2 As Double
On Error Resume Next
Application.DisplayAlerts = False
Set r1 = Application.InputBox("最初のセルを設定してください", "LineDraw1", Type:=8)
Application.DisplayAlerts = True
If r1 Is Nothing Then Exit Sub
On Error GoTo 0
Application.Goto r1.Offset(, 10)
On Error Resume Next
Application.DisplayAlerts = False
Set r2 = Application.InputBox("最初のセル: '" & r1.Address(0, 0) & "'" & vbCrLf & _
"二点目のセルを設定してください", "LineDraw2", Type:=8)
Application.DisplayAlerts = True
If r2 Is Nothing Then Exit Sub
On Error GoTo 0
Union(r1, r2).Select
If MsgBox("'" & r1.Address(0, 0) & ":" & r2.Address(0, 0) & "'" & _
vbCrLf & "でよろしいですか?", _
vbInformation + vbOKCancel) = vbCancel Then Exit Sub
'+以降で、線を中央に動かしている,微調整は、ここでする
x1 = r1.Left + Int(r1.Width / 2)
y1 = r1.Top + Int(r1.Height / 2)
x2 = r2.Left + Int(r2.Width / 2)
y2 = r2.Top + Int(r2.Height / 2)
With ActiveSheet.Shapes.AddLine(x1, y1, x2, y2)
'オプション(色だけは指定したほうが良い Verよって誤動作する)
.Line.Weight = 0.75
.Line.Visible = msoTrue
.Line.ForeColor.SchemeColor = 8 '黒
'セルに何度も使う場合は無駄と思っても必ず入れる,入れないと消える
.Visible = True
End With
r2.Select
Set r1 = Nothing: Set r2 = Nothing
'画面が切り替わらないときは、ここを外してください。
'Application.ScreenUpdating = True
End Sub
Wendy02 さん、こんにちは。
今回も目を留めていただき、ありがとうございます。
教えていただいた方法で、うまくいきました。
コードの中で、ひとつ教えていただきたいのですが、
>x1 = r1.Left + Int(r1.Width / 2)
>y1 = r1.Top + Int(r1.Height / 2)
>x2 = r2.Left + Int(r2.Width / 2)
>y2 = r2.Top + Int(r2.Height / 2)
この部分は、選択したセルのどの位置からどの位置まで線を引くのかを指定しているのですよね?この中の Left や Top を Right や Bottom に変更することはできるのでしょうか?
実際にしてみたのですが、エラーが出てしまいまして。。。
コード内のコメントに『'+以降で、線を中央に動かしている,微調整は、ここでする』とありましたので、+以降の部分は削除したのですが、それがいけなかったのでしょうか…?
この部分に合わせて、セルを選択すれば良いことなのですが、もしよろしければ、教えていただけると嬉しいです。
No.7
- 回答日時:
こんにちは、ham_kamoです。
> オートシェイプの種類で、直線と同じような『直線コネクタ』と
> いうのがありますが、これは、『直線』とどのような違いが
> あるのでしょうか?
直線コネクタに限らず、コネクタ類のオートシェイプは、他の図形と結合することができます。
たとえば、直線コネクタを一本引き、次に四角形を描きます。すると、四角形の四隅と各辺の中央に□マークが現れます。直線コネクタの端をドラッグして四角形の辺の真ん中の□マークに近づけると、青い印が現れて、その状態でドロップすると赤い□マークに変わります。これで直線と四角形が結合されます。
その状態で四角形を移動すると、直線コネクタがついてくると思います。もう一つ四角形を追加して、直線コネクタのもう一つの端をそちらの四角形に連結し、図形をいろいろ移動してみると、どんな感じかわかると思います。要は、図形を描画するときにその位置関係を保つように「コネクト」するのがコネクタなのです。
したがって、単に直線1本ひくだけなら、直線コネクタでも単なる直線でも、どちらでもかまわないと思います。ちなみに、どちらもAltキーを押しながら調整すると、セルにぴったりあわせて端の位置を調整することができます。
ham_kamo さん、こんばんは。
何度もすみません。。。
丁寧に説明してくださったおかげで、ずっと気になっていたことがわかって、スッキリしました!
斜線(直線コネクタ)のサイズを設定しているときに、コネクタの端が緑から赤に変わったりするのも、目にしたことがありましたので、この回答をいただいて、大変参考になりました。ありがとうございました。
No.5
- 回答日時:
こんにちは。
Wendy02です。オートシェイプだけは、たぶん、教本では学ぶことが出来ませんね。細かく出ている本を見たことがありません。私の書くのは、どうしようもない失敗の連続から学んだものですが、これは、VBとも違いますので、私は難しく思います。
>この中の Left や Top を Right や Bottom に変更することはできるのでしょうか?
Top
↓ ←Left
+----------------+ ↑
| セル | Height
| r1 | ↓
+----------------+
← Width →
ということになっていますから、
Right ということになると、r1.Left + r1.Width
つまり、言い換えると、r1.Offset(,1).Left と同じことになります。
Bottom は、r1.Top + r1.Height
つまり、言い換えると、r1.Offset(1).Top と同じことになります。
なお、前回のコードのミスですが、[Int(r1.Width / 2)] は、もともと、Double 型でしたので、あえて、Int で整数にする必要がありませんでした。[r1.Width / 2]で可能です。
再度の回答ありがとうございます。
丁寧に説明していただいたおかげで、よくわかりました。
Left と Top での表現に置き換えるということは、マクロでは、 Right や Bottom という書き方はしないということでしょうか?(すみません。質問攻めのようになってしまって…)
Wendy02 さんから教えていただいた書き方で、コードを変更していると、入力候補のようなものが表示されますが、その中には、Right や Bottom が見当たらなかったような気がしましたので。。。
No.4
- 回答日時:
No.2のham_kamoです。
右上から左下への斜線だったのですね。
マクロを修正してみました。
昨日は何か勘違いして、マクロで余計な処理をしており、不要なFunctionを作っていましたが、今回は不要です。昨日のマクロは全部ばっさり削除して、以下のマクロに置きかえてみてください。
Sub 斜線を引く()
Dim BeginX As Long, BeginY As Long
Dim EndX As Long, EndY As Long
With Selection
BeginY = .Cells(1).Top
BeginX = .Cells(.Cells.Count).Left + .Cells(.Cells.Count).Width
EndX = .Cells(1).Left
EndY = .Cells(.Cells.Count).Top + .Cells(.Cells.Count).Height
End With
ActiveSheet.Shapes.AddLine BeginX, BeginY, EndX, EndY
End Sub
再度の回答ありがとうございます。
おかげさまで、希望通りのことができて、嬉しいです。
このサイトや他のサイトでも、“オートシェイプ”で検索してみたのですが、なかなか参考になりそうなものがなかったので、大変助かりました。
あの…ついでというわけではないのですが、オートシェイプの種類で、直線と同じような『直線コネクタ』というのがありますが、これは、『直線』とどのような違いがあるのでしょうか?手動でサイズの調整等をしていたときは、『直線』ではなくて、『直線コネクタ』が挿入されていて、それを必要に応じてサイズを変更していました。。。
No.2
- 回答日時:
マウスで選択した範囲に、左上から右下に斜線を挿入するマクロです。
Alt+F11でVBAの画面を開き、左側のツリーからブック名を選択し、右クリックから「挿入」>「標準モジュール」を選択して、右の画面に以下のマクロをコピーして貼り付けてください。
Sub 斜線を引く()
If Selection.Cells.Count < 2 Then
MsgBox "2つ以上のセルを選択してください。"
Exit Sub
End If
Dim BeginX As Long, BeginY As Long
Dim EndX As Long, EndY As Long
With Selection
BeginX = GetPosX(.Cells(1))
BeginY = GetPosY(.Cells(1))
EndX = GetPosX(.Cells(.Cells.Count).Offset(1, 1)) - 1
EndY = GetPosY(.Cells(.Cells.Count).Offset(1, 1)) - 1
End With
ActiveSheet.Shapes.AddLine BeginX, BeginY, EndX, EndY
End Sub
Function GetPosX(R As Range) As Long
If R.Column = 1 Then
GetPosX = 0
Else
GetPosX = Range(Cells(1, 1), Cells(1, R.Column - 1)).Width
End If
End Function
Function GetPosY(R As Range) As Long
If R.Row = 1 Then
GetPosY = 0
Else
GetPosY = Range(Cells(1, 1), Cells(R.Row - 1, 1)).Height
End If
End Function
シート上で斜線を引きたい範囲をマウスで選択し(始点と終点でなく、範囲全体を選択してください)、マクロを実行してください。
ham_kamo さん、こんにちは。
今回も目に留めていただき、ありがとうございます。
早速、教えていただいた方法で試してみたところ、うまくいったのですが、選択した範囲に、左下から右上に斜線を引くことはできますか?
質問文にどちらの方向に向かって斜線を引くか書いておけばよかったのですが。。。
オートシェイプに関するマクロは初めてなのですが、コードを少しいじってみたところ、斜線の向きを上方向(/←こんな感じです)に変えることはできましたが、選択範囲から大きくはみ出して、斜線が引かれてしまいました(^_^;)
もしよろしければ、どのようにすれば良いか、教えていただけると嬉しいです。
No.1
- 回答日時:
セルの位置が判るのでしたら、斜め罫線ではどうでしょうか
例えば
-------------------
Sub naname()
Range("A1").Select
With Selection.Borders(xlDiagonalUp)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End Sub
------------------
で、A1に斜めに線が引けます
早々のご回答ありがとうございます。
今回の場合は、罫線だとちょっと都合が悪いのです。
書き方がまぎらわしくて申し訳なかったのですが、例えばA5:E1の端から端に1本斜線を引きたいので、オートシェイプを使っています。
やはり、罫線では、このようなことはできませんよね。。。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・ゆるやかでぃべーと タイムマシンを破壊すべきか。
- ・「I love you」 をかっこよく翻訳してみてください
- ・歩いた自慢大会
- ・許せない心理テスト
- ・字面がカッコいい英単語
- ・昔のあなたへのアドバイス
- ・かっこよく答えてください!!
- ・あなたが好きな本屋さんを教えてください
- ・スタッフと宿泊客が全員斜め上を行くホテルのレビュー
- ・【大喜利】【投稿~8/27】 こんなガソリンスタンド二度と来るか!なぜそう思った?
- ・これ何て呼びますか Part2
- ・人生で一番思い出に残ってる靴
- ・【お題】動物のキャッチフレーズ
- ・【お題】甲子園での思い出の残し方
- ・ゆるやかでぃべーと すべての高校生はアルバイトをするべきだ。
- ・「それ、メッセージ花火でわざわざ伝えること?」
- ・自分用のお土産
- ・人生で一番お金がなかったとき
- ・一番好きなみそ汁の具材は?
- ・泣きながら食べたご飯の思い出
- ・ちょっと先の未来クイズ第1問
- ・ゴリラ向け動画サイト「ウホウホ動画」にありがちなこと
- ・初めて自分の家と他人の家が違う、と意識した時
- ・単二電池
- ・チョコミントアイス
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
EXCELで特定のセルに表示...
-
エクセル 数字をすべて○などの...
-
Excel内での検索結果をシート...
-
Excelで、図形内の文字をセルに...
-
クリックすると文章が表示され...
-
ページ内ハイパーリンクの表示...
-
太字に設定されているセルの個...
-
Excel2007 色のカウント (VBA)
-
Excel ハイパーリンクのURLを別...
-
【EXCEL】先週の月曜日の日付を...
-
セルがクリックされた回数をカ...
-
マクロを実行すると画像がズレ...
-
エクセルでページ数をあるセル...
-
エクセルマクロ 赤色の文字を検...
-
アポストロフィーの一括挿入 ...
-
未記入がある場合はマクロを実...
-
[EXCEL] フォント変更が正常に...
-
EXCELのセルや文字色の反映
-
エクセル マクロで画像を指定...
-
VBA(エクセル)のコンパイルエラー
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
EXCELで特定のセルに表示...
-
エクセル 数字をすべて○などの...
-
Excel内での検索結果をシート...
-
クリックすると文章が表示され...
-
太字に設定されているセルの個...
-
Excelで、図形内の文字をセルに...
-
セルがクリックされた回数をカ...
-
フォントの色を指定して削除出...
-
Excel ハイパーリンクのURLを別...
-
エクセルでPDFリンクを大量...
-
Excelでセルをクリックす...
-
マクロを実行すると画像がズレ...
-
VBA 見つからなかった時の処理
-
Excelで挿入した図をセルの中央...
-
エクセルでの検索ボックスの作...
-
現在のセルの位置を返す関数は...
-
Excel2007 色のカウント (VBA)
-
アポストロフィーの一括挿入 ...
-
セル背景や文字を点滅させる方法
-
エクセルでページ数をあるセル...
おすすめ情報