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を探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・人生のプチ美学を教えてください!!
- ・10秒目をつむったら…
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・【大喜利】【投稿~9/18】 おとぎ話『桃太郎』の知られざるエピソード
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
EXCELで特定のセルに表示...
-
Excel内での検索結果をシート...
-
エクセル 数字をすべて○などの...
-
VBA 見つからなかった時の処理
-
クリックすると文章が表示され...
-
フォントの色を指定して削除出...
-
現在のセルの位置を返す関数は...
-
アポストロフィーの一括挿入 ...
-
太字に設定されているセルの個...
-
Excel ハイパーリンクのURLを別...
-
Excelで、図形内の文字をセルに...
-
エクセルでPDFリンクを大量...
-
選択したセル範囲に入っている...
-
エクセル 未入力セルがあると...
-
マクロを実行すると画像がズレ...
-
excelのソルバーをVBAで複数行...
-
Excel2007 色のカウント (VBA)
-
エクセルでページ数をあるセル...
-
[EXCEL] フォント変更が正常に...
-
Excelでセルをクリックす...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
EXCELで特定のセルに表示...
-
Excel内での検索結果をシート...
-
エクセル 数字をすべて○などの...
-
クリックすると文章が表示され...
-
太字に設定されているセルの個...
-
Excelで、図形内の文字をセルに...
-
Excelでセルをクリックす...
-
Excel ハイパーリンクのURLを別...
-
ページ内ハイパーリンクの表示...
-
マクロを実行すると画像がズレ...
-
現在のセルの位置を返す関数は...
-
セル背景や文字を点滅させる方法
-
エクセルでPDFリンクを大量...
-
EXCELのセルや文字色の反映
-
エクセル 未入力セルがあると...
-
【EXCEL】先週の月曜日の日付を...
-
エクセルでページ数をあるセル...
-
セルがクリックされた回数をカ...
-
VBA 見つからなかった時の処理
-
フォントの色を指定して削除出...
おすすめ情報