Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

31644 / 76738

←次へ　｜　前へ→


	【50341】指定範囲で入力値に丸付け

えみけん - 07/7/20(金) 11:13 -


	引用なし

	パスワード

作業シート内で1か2を入力すると○を付けることはできますが、
指定した範囲（例．Range("A1:A10"))内だけに限定することができません。
範囲を限定する方法を教えてください。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim MR As Range

　　For Each MR In Target
　　　　If MR.Value = 1 Or MR.Value = 2 Then
　　　　　　MR.Select
　　　　　　Call KetsujiCircleDrawing(8, 1)
　　　　MR.Select
　　　　MR.Offset(1, 0).Activate
　　　　Else
　　　　End If
　　 Next
　
End Sub

'/////////　円を表示 /////////

Public Sub KetsujiCircleDrawing(c As Long, line_width As Double)

Dim T, L, W, H, OvalOffset As Double

T = Selection.Top
L = Selection.Left
W = Selection.Width
H = Selection.Height
OvalOffset = 3#

'ActiveSheet.Shapes.AddShape(msoShapeOval, L + (W / 2#) - ((H + OvalOffset) / 2#), T + 1, H + OvalOffset, H - 2).Select
ActiveSheet.Shapes.AddShape(msoShapeOval, L + (W / 2#) - ((H + OvalOffset) / 2#), _
T + 1, H + OvalOffset, H - 1).Select

Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Fill.Transparency = 0#
Selection.ShapeRange.Line.Weight = line_width
Selection.ShapeRange.Line.DashStyle = msoLineSolid
Selection.ShapeRange.Line.Style = msoLineSingle
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Line.ForeColor.SchemeColor = c
Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255)

End Sub

0 hits

▼

【50341】指定範囲で入力値に丸付け えみけん 07/7/20(金) 11:13

≪