Giới hạn vùng hoạt động của macro

[anhtuan1066]

Tôi có code sau:

Private Sub Worksheet_SelectionChange(ByVal tagert As Range)
With ActiveCell
   .Font.Name = "Wingdings"
   .Font.Size = 14
   .FormulaR1C1 = "þ"
   .HorizontalAlignment = xlCenter
End With
End Sub

Code này dùng đễ Insert ký tự Check mark vào ActiveCell... Nhưng tôi muốn giới hạn vùng hoạt động của macro này, chẳng hạn từ B5 đến D20 thì phải thêm code gì?
Nhờ các bạn giúp với
ANH TUẤN

 

[SoiBien]

Bác dùng hàm Intersect để kiểm tra

[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] Worksheet_SelectionChange([COLOR=darkblue]ByVal[/COLOR] Target [COLOR=darkblue]As[/COLOR] Range)
    [COLOR=darkblue]If[/COLOR] [COLOR=darkblue]Not[/COLOR] Intersect(Target, Range("b5:d20")) [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR]
        [COLOR=darkblue]With[/COLOR] ActiveCell
            .Font.Name = "Wingdings"
            .Font.Size = 14
            .FormulaR1C1 = "þ"
            .HorizontalAlignment = xlCenter
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
End [COLOR=darkblue]Sub[/COLOR]

P/s: trò này hay phết bác ạ.

 

[anhtuan1066]

Hi... hi... Tôi biết phát biểu cái "thuật toán" mà mình muốn nhưng lại ko biết "nói" thế nào cho thằng Excel nó hiểu đúng ý mình... Cứ như là người Trái Đất nói chuyện với người ngoài hành tinh vậy! ha... ha...
Cám ơn Soibien! Rất đơn giản
--------------------------------------
Giờ nâng cấp thêm tí nha! Ví dụ tôi muốn bấm thêm nhát nữa thì sẽ xóa Check Mark.. vậy phải thêm gì vào nữa
ANH TUẤN

 

[SoiBien]

Nếu vậy thì bác sẽ check thêm xem là target có empty không?

đây là code để bác tham khảo

[color=darkblue]Private[/color] [color=darkblue]Sub[/color] Worksheet_SelectionChange([color=darkblue]ByVal[/color] Target [color=darkblue]As[/color] Range)
    [color=darkblue]If[/color] [color=darkblue]Not[/color] Intersect(Target, Range("b5:d20")) [color=darkblue]Is[/color] [color=darkblue]Nothing[/color] [color=darkblue]Then[/color]
        [color=darkblue]If[/color] IsEmpty(Target) [color=darkblue]Then[/color]
            [color=darkblue]With[/color] ActiveCell
                .Font.Name = "Wingdings"
                .Font.Size = 14
                .FormulaR1C1 = "þ"
                .HorizontalAlignment = xlCenter
            [color=darkblue]End[/color] [color=darkblue]With[/color]
        [color=darkblue]Else[/color]
            Target.ClearContents
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]End[/color] [color=darkblue]If[/color]
End [color=darkblue]Sub[/color]

 

[anhtuan1066]

Uh... Tôi thì ko biết nhiều về code, nhưng tôi cũng suy luận dc 1 cách:

Private Sub Worksheet_SelectionChange(ByVal Tagert As Range)
 If Not Intersect(Tagert, Range("B5:D20")) Is Nothing Then
    If ActiveCell.Value <> "" Then
       ActiveCell.ClearContents
    Else:
      With ActiveCell
        .Value = "þ"
        .Font.Name = "Wingdings"
        .Font.Size = 14
        .HorizontalAlignment = xlCenter
      End With
    End If
 End If
End Sub

Thế nhưng cả code của tôi lẩn Soibien đều gặp 1 trục trặc nhỏ, đó là khi chọn vào 1 cell đang rỗng thì nó điền vào 1 check mark.. chọn lại lần nữa vào ngay cell đó thì nó sẽ ko hoạt động... Nếu muốn xóa cell vừa chọn phải click chuột chọn ngoài vùng B520 trước, sau đó chọn lại thì mới dc... Đại khái là ko thể chọn 2 lần liên tiếp vào cùng 1 cell
Vậy cải tiến việc này như thế nào đây?
ANH TUẤN

 

[SoiBien]

Ngay tên sự kiện đã có ý nghĩa rồi anh, Selectchange, giống như cái vụ Combobox của anh vậy, chọn 2 lần liên tiếp một giá trị thì nó không hiểu, vì có change đâu mà.

 

[minhlev]

Em nhớ là trước đây bác đã đề cập tới vấn đề này rồi mà. Và giải pháp lúc đó là thêm dòng code ' Cells(1,1).Select ' vào trước dòng End Sub. Còn cách khác thì chưa thấy ai nói tới.

 

[anhtuan1066]

Uh... có... và nó dùng Double Click như sau:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("B5:D20")) Is Nothing Then
            Cancel = True
            If Target = vbNullString Then
                      With Target
                        .Value = "þ"
                        .Font.Name = "Wingdings"
                        .Font.Size = 14
                        .HorizontalAlignment = xlCenter
                      End With
            Else: Target = vbNullString
            End If
    End If
End Sub

Nhưng nếu ko dùng Double Click thì có làm dc ko?
Còn cái code mà bạn minhlev vừa nói chủ yếu là dời ActiveCell đi.. đây cũng là 1 giãi pháp... Nhưng ngoài 2 cách này thì còn cách nào khác hơn nữa?
ANH TUẤN