vẽ vòng tròn Oval theo vị trí định sẵn

hic1802 · 11/6/21

Xin chào mọi người trên GPE,
Hôm nay em có bài toán nhờ mọi người giúp đỡ là : làm sao để vẽ chèn biểu tượng Oval vào đúng vị trí mình mong muốn tự động như hình phía dưới tức là khi ta điền nội dung vào 3 cột A,B,C thì sẽ tự động chèn Oval (với tên được đặt như cột C) vào vị trí ô cell như trục tọa độ cột A và cột B.
Em xin cảm ơn.

batman1 · 11/6/21

Thử nhé.

1. Sửa lại trục X là hướng sang phải, trục Y hướng lên trên.

2. Phải chuột trên tên sheet ở "sheet tabs" ở dưới cùg -> View code -> dán code sau

Mã:

Private Sub Worksheet_Change(ByVal Target As range)
Dim cell_ As range, x As Long, y As Long, a As Long
    If Target.Row < 3 Or Target.Column > 3 Or Target.Count > 1 Then Exit Sub
    Application.EnableEvents = False
   
    If Target.Column < 3 Then
        If Not IsNumeric(Target.Value) Then
            MsgBox "Toa do khong la gia tri so"
            Target.Value = Empty
        Else
            If Target.Column = 1 Then
                a = Me.range("F11").Column + Target.Value
            Else
                a = Me.range("F11").Row - Target.Value
            End If
            If a < 1 Then
                MsgBox "Toa do x hoac y khong hop le"
                Target.Value = Empty
            End If
            a = Target.Value
            Target.Value = a
        End If
    End If
    Application.EnableEvents = True
    Set cell_ = Target.Offset(, 1 - Target.Column)
    If Len(cell_.Value) > 0 And Len(cell_.Offset(, 1).Value) > 0 And Len(cell_.Offset(, 2).Value) > 0 Then
        Set cell_ = Me.range("F11").Offset(-cell_.Offset(, 1).Value, cell_.Value)
        With Me.Shapes.AddShape(msoShapeOval, cell_.left, cell_.top, cell_.Width, cell_.Height)
            .Fill.Visible = msoFalse
            .Name = Target.Offset(, 3 - Target.Column).Value
        End With
    End If
End Sub

Nếu nhập tọa độ x âm hoặc y âm thì tính về bên trái hoặc xuống dưới. Nếu tính về bên trái hoặc lên trên mà ra khỏi trang tính thì code báo lỗi. Nếu nhập tọa độ có phần thập phân thì code sẽ làm tròn.

hoangtuaotrang_hp_vn · 11/6/21

batman1 đã viết:
Thử nhé.

1. Sửa lại trục X là hướng sang phải, trục Y hướng lên trên.

2. Phải chuột trên tên sheet ở "sheet tabs" ở dưới cùg -> View code -> dán code sau

Mã:

Private Sub Worksheet_Change(ByVal Target As range) Dim cell_ As range, x As Long, y As Long, a As Long If Target.Row < 3 Or Target.Column > 3 Or Target.Count > 1 Then Exit Sub Application.EnableEvents = False If Target.Column < 3 Then If Not IsNumeric(Target.Value) Then MsgBox "Toa do khong la gia tri so" Target.Value = Empty Else If Target.Column = 1 Then a = Me.range("F11").Column + Target.Value Else a = Me.range("F11").Row - Target.Value End If If a < 1 Then MsgBox "Toa do x hoac y khong hop le" Target.Value = Empty End If a = Target.Value Target.Value = a End If End If Application.EnableEvents = True Set cell_ = Target.Offset(, 1 - Target.Column) If Len(cell_.Value) > 0 And Len(cell_.Offset(, 1).Value) > 0 And Len(cell_.Offset(, 2).Value) > 0 Then Set cell_ = Me.range("F11").Offset(-cell_.Offset(, 1).Value, cell_.Value) With Me.Shapes.AddShape(msoShapeOval, cell_.left, cell_.top, cell_.Width, cell_.Height) .Fill.Visible = msoFalse .Name = Target.Offset(, 3 - Target.Column).Value End With End If End Sub

Nếu nhập tọa độ x âm hoặc y âm thì tính về bên trái hoặc xuống dưới. Nếu tính về bên trái hoặc lên trên mà ra khỏi trang tính thì code báo lỗi. Nếu nhập tọa độ có phần thập phân thì code sẽ làm tròn.

Hay quá bác, bác có thể thêm chức năng: khi mình xóa dữ liệu ở cột A, B, C thì vòng tròn cũng bị xóa đi không ạ?

ptm0412 · 11/6/21

hic1802 đã viết:
Hôm nay em có bài toán nhờ mọi người giúp đỡ là : làm sao để vẽ chèn biểu tượng Oval vào đúng vị trí mình mong muốn tự động như hình phía dưới tức là khi ta điền nội dung vào 3 cột A,B,C thì sẽ tự động chèn Oval (với tên được đặt như cột C) vào vị trí ô cell như trục tọa độ cột A và cột B.

Vẽ đồ thị thì đâu cần code. Thêm bớt dữ liệu đều tự động cả. Âm dương, nguyên phân đều được luôn

batman1 · 11/6/21

ptm0412 đã viết:
Vẽ đồ thị thì đâu cần code.

Tôi thì lại hiểu là vẽ oval TRÊN SHEET, tức chả liên quan gì tới đồ thị cả. Nếu là vẽ đồ thị thì người ta phải chèn Chart trong ví dụ chứ nhỉ.

ptm0412 · 11/6/21

batman1 đã viết:
Tôi thì lại hiểu là vẽ oval TRÊN SHEET, tức chả liên quan gì tới đồ thị cả. Nếu là vẽ đồ thị thì người ta phải chèn Chart trong ví dụ chứ nhỉ.

À, ý tôi không nói anh mà là nói chủ đề tài. Nếu dùng biểu đồ thay cho vẽ trên sheet thì đơn giản hơn. Mà cũng có thể muốn vẽ chart mà minh hoạ bằng cells không chừng.

Pi-Pikachu · 11/6/21

batman1 đã viết:
Thử nhé.

1. Sửa lại trục X là hướng sang phải, trục Y hướng lên trên.

2. Phải chuột trên tên sheet ở "sheet tabs" ở dưới cùg -> View code -> dán code sau

Mã:

Private Sub Worksheet_Change(ByVal Target As range) Dim cell_ As range, x As Long, y As Long, a As Long If Target.Row < 3 Or Target.Column > 3 Or Target.Count > 1 Then Exit Sub Application.EnableEvents = False If Target.Column < 3 Then If Not IsNumeric(Target.Value) Then MsgBox "Toa do khong la gia tri so" Target.Value = Empty Else If Target.Column = 1 Then a = Me.range("F11").Column + Target.Value Else a = Me.range("F11").Row - Target.Value End If If a < 1 Then MsgBox "Toa do x hoac y khong hop le" Target.Value = Empty End If a = Target.Value Target.Value = a End If End If Application.EnableEvents = True Set cell_ = Target.Offset(, 1 - Target.Column) If Len(cell_.Value) > 0 And Len(cell_.Offset(, 1).Value) > 0 And Len(cell_.Offset(, 2).Value) > 0 Then Set cell_ = Me.range("F11").Offset(-cell_.Offset(, 1).Value, cell_.Value) With Me.Shapes.AddShape(msoShapeOval, cell_.left, cell_.top, cell_.Width, cell_.Height) .Fill.Visible = msoFalse .Name = Target.Offset(, 3 - Target.Column).Value End With End If End Sub

Nếu nhập tọa độ x âm hoặc y âm thì tính về bên trái hoặc xuống dưới. Nếu tính về bên trái hoặc lên trên mà ra khỏi trang tính thì code báo lỗi. Nếu nhập tọa độ có phần thập phân thì code sẽ làm tròn.

Hay quá, vậy làm sao để khi thay đổi chỉ số thì các vòng tròn cũng tự động xóa vị trí cũ rồi cập nhật vào vị trí mới vậy bạn ?

batman1 · 11/6/21

hoangtuaotrang_hp_vn đã viết:
Hay quá bác, bác có thể thêm chức năng: khi mình xóa dữ liệu ở cột A, B, C thì vòng tròn cũng bị xóa đi không ạ?

Pi-Pikachu đã viết:
Hay quá, vậy làm sao để khi thay đổi chỉ số thì các vòng tròn cũng tự động xóa vị trí cũ rồi cập nhật vào vị trí mới vậy bạn ?

Thử kiểm tra xem, tôi không test kỹ.

Xóa ở cột C (A và B không bắt buộc) thì xóa Oval.

Mã:

Private Sub Worksheet_Change(ByVal Target As range)
Dim cell_ As range, x As Long, y As Long, a As Long
    If Target.Row < 3 Or Target.Column > 3 Or Target.Count > 1 Then Exit Sub
    Application.EnableEvents = False
    
    If Target.Column < 3 Then
        If Not IsNumeric(Target.Value) Then
            MsgBox "Toa do khong la gia tri so"
            Target.Value = Empty
        Else
            If Target.Column = 1 Then
                a = Me.range("F11").Column + Target.Value
            Else
                a = Me.range("F11").Row - Target.Value
            End If
            If a < 1 Then
                MsgBox "Toa do x hoac y khong hop le"
                Target.Value = Empty
            End If
            a = Target.Value
            Target.Value = a
        End If
    Else
        If Len(Target.Value) = 0 Then
            Application.Undo
            On Error Resume Next
            Me.Shapes(Target.Value).Delete
            On Error GoTo 0
            Target.Value = Empty
        End If
    End If
    Application.EnableEvents = True
    Set cell_ = Target.Offset(, 1 - Target.Column)
    If Len(cell_.Value) > 0 And Len(cell_.Offset(, 1).Value) > 0 And Len(cell_.Offset(, 2).Value) > 0 Then
        On Error Resume Next
        Me.Shapes(Target.Offset(, 3 - Target.Column).Value).Delete
        On Error GoTo 0
        Set cell_ = Me.range("F11").Offset(-cell_.Offset(, 1).Value, cell_.Value)
        With Me.Shapes.AddShape(msoShapeOval, cell_.left, cell_.top, cell_.Width, cell_.Height)
            .Fill.Visible = msoFalse
            .Name = Target.Offset(, 3 - Target.Column).Value
        End With
    End If
End Sub

Pi-Pikachu · 12/6/21

batman1 đã viết:

Thử kiểm tra xem, tôi không test kỹ.

Xóa ở cột C (A và B không bắt buộc) thì xóa Oval.

Mã:

Private Sub Worksheet_Change(ByVal Target As range)
Dim cell_ As range, x As Long, y As Long, a As Long
    If Target.Row < 3 Or Target.Column > 3 Or Target.Count > 1 Then Exit Sub
    Application.EnableEvents = False
   
    If Target.Column < 3 Then
        If Not IsNumeric(Target.Value) Then
            MsgBox "Toa do khong la gia tri so"
            Target.Value = Empty
        Else
            If Target.Column = 1 Then
                a = Me.range("F11").Column + Target.Value
            Else
                a = Me.range("F11").Row - Target.Value
            End If
            If a < 1 Then
                MsgBox "Toa do x hoac y khong hop le"
                Target.Value = Empty
            End If
            a = Target.Value
            Target.Value = a
        End If
    Else
        If Len(Target.Value) = 0 Then
            Application.Undo
            On Error Resume Next
            Me.Shapes(Target.Value).Delete
            On Error GoTo 0
            Target.Value = Empty
        End If
    End If
    Application.EnableEvents = True
    Set cell_ = Target.Offset(, 1 - Target.Column)
    If Len(cell_.Value) > 0 And Len(cell_.Offset(, 1).Value) > 0 And Len(cell_.Offset(, 2).Value) > 0 Then
        On Error Resume Next
        Me.Shapes(Target.Offset(, 3 - Target.Column).Value).Delete
        On Error GoTo 0
        Set cell_ = Me.range("F11").Offset(-cell_.Offset(, 1).Value, cell_.Value)
        With Me.Shapes.AddShape(msoShapeOval, cell_.left, cell_.top, cell_.Width, cell_.Height)
            .Fill.Visible = msoFalse
            .Name = Target.Offset(, 3 - Target.Column).Value
        End With
    End If
End Sub

Hay quá cảm ơn bạn, khi xóa một ô trong cột A hoặc B thì chuẩn rồi nhưng nếu xóa toàn bộ từ 2 ô trở lên thì code không hoạt động.
Tương tự khi nhập cũng vậy nhập một ô thì chuẩn rồi nhưng nếu nhập 1 lúc nhiều ô thì code cũng không hoạt động.

ptm0412 · 12/6/21

Pi-Pikachu đã viết:
Hay quá cảm ơn bạn, khi xóa một ô trong cột A hoặc B thì chuẩn rồi nhưng nếu xóa toàn bộ từ 2 ô trở lên thì code không hoạt động.
Tương tự khi nhập cũng vậy nhập một ô thì chuẩn rồi nhưng nếu nhập 1 lúc nhiều ô thì code cũng không hoạt động.

Đọc code sẽ thấy thôi: Or Target.Count > 1 Then Exit Sub

Pi-Pikachu · 12/6/21

ptm0412 đã viết:
Đọc code sẽ thấy thôi: Or Target.Count > 1 Then Exit Sub

Sửa đoạn này cũng đâu có giải quyết được trường hợp nhập nhiều ô hay xóa nhiều ô cùng một lúc bạn nhỉ.

batman1 · 12/6/21

Pi-Pikachu đã viết:
Hay quá cảm ơn bạn, khi xóa một ô trong cột A hoặc B thì chuẩn rồi nhưng nếu xóa toàn bộ từ 2 ô trở lên thì code không hoạt động.
Tương tự khi nhập cũng vậy nhập một ô thì chuẩn rồi nhưng nếu nhập 1 lúc nhiều ô thì code cũng không hoạt động.

Thì chủ ý của tôi là vậy mà. Trích code

Or Target.Count > 1 Then Exit Sub

ptm0412 · 12/6/21

Pi-Pikachu đã viết:
Sửa đoạn này cũng đâu có giải quyết được trường hợp nhập nhiều ô hay xóa nhiều ô cùng một lúc bạn nhỉ.

Bạn thử chưa? và thử sửa thế nào?
Tuy nhiên nếu sửa để cho có thể điền cùng lúc hoặc xoá cùng lúc nhiều ô, sẽ phải xử lý nhiều tình huống gây lỗi khác, hoặc tình huống phải rẽ nhánh nhiều hơn.

Pi-Pikachu · 12/6/21

ptm0412 đã viết:
Bạn thử chưa? và thử sửa thế nào?
Tuy nhiên nếu sửa để cho có thể điền cùng lúc hoặc xoá cùng lúc nhiều ô, sẽ phải xử lý nhiều tình huống gây lỗi khác, hoặc tình huống phải rẽ nhánh nhiều hơn.

Tôi thử như sau:
trong code bỏ: Or Target.Count > 1

trên bảng tính chọn những ô màu đỏ:

Kết quả sau khi nhập:

Kết quả phải là (có 2 vòng tròn vì trùng tọa độ nên đè lên nhau kéo ra là thấy) :

Chọn 3 ô màu đỏ rồi xóa, kết quả là tọa độ 3,5 vẫn còn hình tròn:

nên tôi mới thông tin "sửa đoạn này (bỏ Or Target.Count > 1 ) cũng đâu có giải quyết được trường hợp nhập nhiều ô hay xóa nhiều ô cùng một lúc"

batman1 · 12/6/21

Pi-Pikachu đã viết:
nên tôi mới thông tin "sửa đoạn này (bỏ Or Target.Count > 1 ) cũng đâu có giải quyết được trường hợp nhập nhiều ô hay xóa nhiều ô cùng một lúc"

Suy nghĩ một chút đi. Không thể chỉ đơn thuần xóa Or Target.Count > 1. Toàn bộ code sau dòng đầu tiên được viết cho trường hợp Target.Count = 1. Vì với Target.Count > 1 thì đã có Exit Sub rồi nên code sau dòng 1 sẽ không được thực hiện. Code từ dòng 2 được viết cho trường hợp Target.Count = 1 nên nó không xét những tình huống sảy ra khi Target.Count > 1. Chính vì thế xóa Or Target.Count > 1 không đủ vì code đi tiếp nhưng phần đi tiếp không phục vụ Target.Count > 1.

Lúc trước khi nhập tọa độ không hợp lệ (chữ, hoặc tọa độ ngoài trang tính) thì có MsgBox. Bây giờ phục vụ nhập và xóa nhiều ô nên không nên dùng MsgBox nữa. Khi nhập tọa độ không hợp lệ thì code biến chúng thành 0.

Mã:

Private Sub Worksheet_Change(ByVal Target As range)
Dim shp As Shape, cell_ As range, dong As range, rng As range, a As Long, ten As String
    Set rng = Intersect(Me.range("A3:C1000"), Target)
    If rng Is Nothing Then Exit Sub
    Application.EnableEvents = False
    On Error Resume Next
    For Each shp In Me.Shapes
        If Application.CountIf(Me.range("C3:C1000"), shp.Name) = 0 Then shp.Delete
    Next shp
    On Error Resume Next
    For Each cell_ In rng
        If cell_.Column < 3 Then
            If Not IsNumeric(cell_.Value) Then
                cell_.Value = Empty
            Else
                If cell_.Column = 1 Then
                    a = Me.range("F11").Column + cell_.Value
                Else
                    a = Me.range("F11").Row - cell_.Value
                End If
                If a < 1 Then cell_.Value = Empty
                a = cell_.Value
                cell_.Value = a
            End If
        End If
    Next cell_

    Application.EnableEvents = True

    For Each dong In rng
        Set cell_ = Me.range("A" & dong.Row)
        ten = cell_.Offset(, 2).Value
        If Len(cell_.Value) > 0 And Len(cell_.Offset(, 1).Value) > 0 And Len(ten) > 0 Then
            On Error Resume Next
            Me.Shapes(ten).Delete
            On Error GoTo 0
            Set cell_ = Me.range("F11").Offset(-cell_.Offset(, 1).Value, cell_.Value)
            With Me.Shapes.AddShape(msoShapeOval, cell_.left, cell_.top, cell_.Width, cell_.Height)
                .Fill.Visible = msoFalse
                .Name = ten
            End With
        End If
    Next dong
End Sub

Pi-Pikachu · 12/6/21

batman1 đã viết:
Suy nghĩ một chút đi. Không thể chỉ đơn thuần xóa Or Target.Count > 1. Toàn bộ code sau dòng đầu tiên được viết cho trường hợp Target.Count = 1. Vì với Target.Count > 1 thì đã có Exit Sub rồi nên code sau dòng 1 sẽ không được thực hiện. Code từ dòng 2 được viết cho trường hợp Target.Count = 1 nên nó không xét những tình huống sảy ra khi Target.Count > 1. Chính vì thế xóa Or Target.Count > 1 không đủ vì code đi tiếp nhưng phần đi tiếp không phục vụ Target.Count > 1.

Lúc trước khi nhập tọa độ không hợp lệ (chữ, hoặc tọa độ ngoài trang tính) thì có MsgBox. Bây giờ phục vụ nhập và xóa nhiều ô nên không nên dùng MsgBox nữa. Khi nhập tọa độ không hợp lệ thì code biến chúng thành 0.

Mã:

Private Sub Worksheet_Change(ByVal Target As range) Dim shp As Shape, cell_ As range, dong As range, rng As range, a As Long, ten As String Set rng = Intersect(Me.range("A3:C1000"), Target) If rng Is Nothing Then Exit Sub Application.EnableEvents = False On Error Resume Next For Each shp In Me.Shapes If Application.CountIf(Me.range("C3:C1000"), shp.Name) = 0 Then shp.Delete Next shp On Error Resume Next For Each cell_ In rng If cell_.Column < 3 Then If Not IsNumeric(cell_.Value) Then cell_.Value = Empty Else If cell_.Column = 1 Then a = Me.range("F11").Column + cell_.Value Else a = Me.range("F11").Row - cell_.Value End If If a < 1 Then cell_.Value = Empty a = cell_.Value cell_.Value = a End If End If Next cell_ Application.EnableEvents = True For Each dong In rng Set cell_ = Me.range("A" & dong.Row) ten = cell_.Offset(, 2).Value If Len(cell_.Value) > 0 And Len(cell_.Offset(, 1).Value) > 0 And Len(ten) > 0 Then On Error Resume Next Me.Shapes(ten).Delete On Error GoTo 0 Set cell_ = Me.range("F11").Offset(-cell_.Offset(, 1).Value, cell_.Value) With Me.Shapes.AddShape(msoShapeOval, cell_.left, cell_.top, cell_.Width, cell_.Height) .Fill.Visible = msoFalse .Name = ten .AlternativeText = cell_.Address End With End If Next dong End Sub

Hay , quá hay luôn , cảm ơn bạn nhiều.

ptm0412 · 12/6/21

Pi-Pikachu đã viết:
Tôi thử như sau:
trong code bỏ: Or Target.Count > 1

Tôi có nói rõ là nếu sửa (như xoá bỏ vụ >1), thì phải lường trước những tình huống gây lỗi và tình huống phải rẽ nhánh. nghĩa là:
- Tô khối nhiều ô bao gồm cả cột A và B, hoặc bao gồm cả B và C. Phải duyệt qua từng ô để xử lý nếu không sẽ lỗi hoặc chạy sai.
- Tô khối nhiều cột bao gồm A, B, C và cả D, E; xoá hoặc nhập liệu (có thể nhập bằng copy paste) : Xoá phải xử lý khác, nhập liệu phải xử lý khác, nhưng cũng phải duyệt lại từng ô
- Nhấn control tô nhiều ô hoặc nhiều khối ô, cũng là 1 tình huống khác phải xử lý

Chứ tôi đâu có bảo "chỉ xoá đi" đâu?

hic1802 · 14/6/21

trên GPE này đúng là toàn các cao thủ thôi haha,
Nếu bây giờ em hỏi câu khó hơn nữa là vẽ theo màu và theo kích thước thì sẽ như thế nào các bác nhỉ?
Em vẫn lấy ví dụ trên nhé

Bài đã được tự động gộp: 14/6/21

batman1 đã viết:
Suy nghĩ một chút đi. Không thể chỉ đơn thuần xóa Or Target.Count > 1. Toàn bộ code sau dòng đầu tiên được viết cho trường hợp Target.Count = 1. Vì với Target.Count > 1 thì đã có Exit Sub rồi nên code sau dòng 1 sẽ không được thực hiện. Code từ dòng 2 được viết cho trường hợp Target.Count = 1 nên nó không xét những tình huống sảy ra khi Target.Count > 1. Chính vì thế xóa Or Target.Count > 1 không đủ vì code đi tiếp nhưng phần đi tiếp không phục vụ Target.Count > 1.

Lúc trước khi nhập tọa độ không hợp lệ (chữ, hoặc tọa độ ngoài trang tính) thì có MsgBox. Bây giờ phục vụ nhập và xóa nhiều ô nên không nên dùng MsgBox nữa. Khi nhập tọa độ không hợp lệ thì code biến chúng thành 0.

Mã:

Private Sub Worksheet_Change(ByVal Target As range) Dim shp As Shape, cell_ As range, dong As range, rng As range, a As Long, ten As String Set rng = Intersect(Me.range("A3:C1000"), Target) If rng Is Nothing Then Exit Sub Application.EnableEvents = False On Error Resume Next For Each shp In Me.Shapes If Application.CountIf(Me.range("C3:C1000"), shp.Name) = 0 Then shp.Delete Next shp On Error Resume Next For Each cell_ In rng If cell_.Column < 3 Then If Not IsNumeric(cell_.Value) Then cell_.Value = Empty Else If cell_.Column = 1 Then a = Me.range("F11").Column + cell_.Value Else a = Me.range("F11").Row - cell_.Value End If If a < 1 Then cell_.Value = Empty a = cell_.Value cell_.Value = a End If End If Next cell_ Application.EnableEvents = True For Each dong In rng Set cell_ = Me.range("A" & dong.Row) ten = cell_.Offset(, 2).Value If Len(cell_.Value) > 0 And Len(cell_.Offset(, 1).Value) > 0 And Len(ten) > 0 Then On Error Resume Next Me.Shapes(ten).Delete On Error GoTo 0 Set cell_ = Me.range("F11").Offset(-cell_.Offset(, 1).Value, cell_.Value) With Me.Shapes.AddShape(msoShapeOval, cell_.left, cell_.top, cell_.Width, cell_.Height) .Fill.Visible = msoFalse .Name = ten End With End If Next dong End Sub

Cái này theo em hiểu là tìm vị trí rồi tạo shapes nhưng em ko biết đặt shape đó tại vị trí (trục X,Y) như thế nào?
câu này có nghĩa là như cách em hiểu đùng ko bác : Me.Shapes.AddShape(msoShapeOval, cell_.left, cell_.top, cell_.Width, cell_.Height)

hic1802 · 19/6/21

batman1 đã viết:
Suy nghĩ một chút đi. Không thể chỉ đơn thuần xóa Or Target.Count > 1. Toàn bộ code sau dòng đầu tiên được viết cho trường hợp Target.Count = 1. Vì với Target.Count > 1 thì đã có Exit Sub rồi nên code sau dòng 1 sẽ không được thực hiện. Code từ dòng 2 được viết cho trường hợp Target.Count = 1 nên nó không xét những tình huống sảy ra khi Target.Count > 1. Chính vì thế xóa Or Target.Count > 1 không đủ vì code đi tiếp nhưng phần đi tiếp không phục vụ Target.Count > 1.

Lúc trước khi nhập tọa độ không hợp lệ (chữ, hoặc tọa độ ngoài trang tính) thì có MsgBox. Bây giờ phục vụ nhập và xóa nhiều ô nên không nên dùng MsgBox nữa. Khi nhập tọa độ không hợp lệ thì code biến chúng thành 0.

Mã:

Private Sub Worksheet_Change(ByVal Target As range) Dim shp As Shape, cell_ As range, dong As range, rng As range, a As Long, ten As String Set rng = Intersect(Me.range("A3:C1000"), Target) If rng Is Nothing Then Exit Sub Application.EnableEvents = False On Error Resume Next For Each shp In Me.Shapes If Application.CountIf(Me.range("C3:C1000"), shp.Name) = 0 Then shp.Delete Next shp On Error Resume Next For Each cell_ In rng If cell_.Column < 3 Then If Not IsNumeric(cell_.Value) Then cell_.Value = Empty Else If cell_.Column = 1 Then a = Me.range("F11").Column + cell_.Value Else a = Me.range("F11").Row - cell_.Value End If If a < 1 Then cell_.Value = Empty a = cell_.Value cell_.Value = a End If End If Next cell_ Application.EnableEvents = True For Each dong In rng Set cell_ = Me.range("A" & dong.Row) ten = cell_.Offset(, 2).Value If Len(cell_.Value) > 0 And Len(cell_.Offset(, 1).Value) > 0 And Len(ten) > 0 Then On Error Resume Next Me.Shapes(ten).Delete On Error GoTo 0 Set cell_ = Me.range("F11").Offset(-cell_.Offset(, 1).Value, cell_.Value) With Me.Shapes.AddShape(msoShapeOval, cell_.left, cell_.top, cell_.Width, cell_.Height) .Fill.Visible = msoFalse .Name = ten End With End If Next dong End Sub

bác ơi, có cách nào chỉ xóa định dạng là vòng tròn Oval còn các shape khác ko xóa được không? Nếu có thì phải chỉnh code như thế nào?

batman1 · 19/6/21

hic1802 đã viết:
bác ơi, có cách nào chỉ xóa định dạng là vòng tròn Oval còn các shape khác ko xóa được không? Nếu có thì phải chỉnh code như thế nào?

Tôi không hiểu.

Xóa định dạng nghĩa là gì?

Là vòng tròn Oval có nghĩa là gì? Oval nào? Là Oval bay lên trời, rơi xuống đất, hay là Oval tan thành mây khói?

vẽ vòng tròn Oval theo vị trí định sẵn

Thành viên tiêu biểu

File đính kèm

Thành viên gạo cội

Thành viên tiêu biểu

Bad Excel Member

File đính kèm

Thành viên gạo cội

Bad Excel Member

Thành viên chính thức

Thành viên gạo cội

Thành viên chính thức

Bad Excel Member

Thành viên chính thức

Thành viên gạo cội

Bad Excel Member

Thành viên chính thức

Thành viên gạo cội

Thành viên chính thức

Bad Excel Member

Thành viên tiêu biểu

File đính kèm

Thành viên tiêu biểu

Thành viên gạo cội

Facebook

Group