Sửa giúp em code xoá đường gạch chéo củ khi số lượng = 0 và > 0 (1 người xem)

[quoc nhat]

Em có cái File này nhờ các anh chị bỏ chút ít thời gian sủa giùm em cái Code gạch chéo để còn lại duy nhất 1 đường gạch chéo khi số lượng =0 hoặc > 0.
Bài này em có nhờ mọi người làm giúp nhưng qua thời gian sử dụng em phải xoá đường gạch chéo củ bằng thủ công em thấy bất tiện và mất thời gian quá nên nhờ mọi người giúp.
Trả giá trị số lượng về số 0 từ dưới lên trên hoặc cho giá trị ở ô số lượng > 0 từ trên xuống dưới các anh chị sẽ thấy nó cho thêm một đường gạch chéo mới mà đường gạch chéo củ không tự xoá đi trong sheet phieuxuat in
các anh chị giúp em với nhé!
Em cảm ơn nhiều!

 

[dhn46]

Trong sự kiện Private Sub Worksheet_Change(ByVal Target As Range) của sheet 1 bạn có đoạn Code xoá Shape

'Xoa duong loai bo
    If nl = 1 Then
            For il = nl To 1 Step -1
            If ActiveSheet.Shapes.Item(il).Connector = -1 Then ActiveSheet.Shapes.Item(il).Delete
            Next il
    End If

=> bạn xoá đoạn này và thay bởi code sau

    For Each shap In ActiveSheet.Shapes
        shap.Delete
    Next

Để biến tường minh thì bạn khai báo biến cho Shap

    Dim shap As Shape

 

[quoc nhat]

Trong sự kiện Private Sub Worksheet_Change(ByVal Target As Range) của sheet 1 bạn có đoạn Code xoá Shape

'Xoa duong loai bo
    If nl = 1 Then
            For il = nl To 1 Step -1
            If ActiveSheet.Shapes.Item(il).Connector = -1 Then ActiveSheet.Shapes.Item(il).Delete
            Next il
    End If

=> bạn xoá đoạn này và thay bởi code sau

    For Each shap In ActiveSheet.Shapes
        shap.Delete
    Next

Để biến tường minh thì bạn khai báo biến cho Shap

    Dim shap As Shape

em làm được rồi
cảm ơn anh

 

[quoc nhat]

Trong sự kiện Private Sub Worksheet_Change(ByVal Target As Range) của sheet 1 bạn có đoạn Code xoá Shape

'Xoa duong loai bo
    If nl = 1 Then
            For il = nl To 1 Step -1
            If ActiveSheet.Shapes.Item(il).Connector = -1 Then ActiveSheet.Shapes.Item(il).Delete
            Next il
    End If

=> bạn xoá đoạn này và thay bởi code sau

    For Each shap In ActiveSheet.Shapes
        shap.Delete
    Next

Để biến tường minh thì bạn khai báo biến cho Shap

    Dim shap As Shape

Cái xóa Shap củ em đã làm được, nhưng lại nảy sinh một vướng mắc là khi Protec Sheet lại thì nó không nhảy shap được mọi người thêm cho em cái code của Shap nhảy được khi protec sheet với và không xóa các Command Button khi thay đổi dữ liệu ở ô số lượng với.
em cảm ơn

 

[viehoai]

Cái xóa Shap củ em đã làm được, nhưng lại nảy sinh một vướng mắc là khi Protec Sheet lại thì nó không nhảy shap được mọi người thêm cho em cái code của Shap nhảy được khi protec sheet với và không xóa các Command Button khi thay đổi dữ liệu ở ô số lượng với.
em cảm ơn

Tì đầu code bạn cho Unprotect Sheet, cuối code Protect Sheet trở lại

 

[quoc nhat]

Tì đầu code bạn cho Unprotect Sheet, cuối code Protect Sheet trở lại

Dạ thưa anh cái đó em Recorde Macro thì em làm được rồi đó anh.
Anh chỉ giúp em phải sửa Code lại như thế nào để khi thay đổi dữ liệu ở cell D174178 -----> Shape nhảy mà không bị xoá các Cotrol khác ví dụ như Command Button , checkbox...... nói chung là các cotrol mà mình vẽ trên sheet.
Anh giúp em với nhé
em cảm ơn

 

[viehoai]

Dạ thưa anh cái đó em Recorde Macro thì em làm được rồi đó anh.
Anh chỉ giúp em phải sửa Code lại như thế nào để khi thay đổi dữ liệu ở cell D174178 -----> Shape nhảy mà không bị xoá các Cotrol khác ví dụ như Command Button , checkbox...... nói chung là các cotrol mà mình vẽ trên sheet.
Anh giúp em với nhé
em cảm ơn

Xóa Shapes có tên là "Line" xóa, còn lại không
[GPECODE=vb]Private Sub Worksheet_Change(ByVal Target As Range)
If IsError([c147]) = True Then UserForm1.Show
If Intersect(Target, [A174:A178,D174178]) Is Nothing Then Exit Sub
On Error Resume Next
ActiveSheet.Unprotect
Dim i As Long
With Sheet4 'The Kho'
i = WorksheetFunction.Match(Cells(Target.Row, 1), .[b:b], 0)
If Cells(Target.Row, 4).Value > .Cells(i, 11).Value Then
MsgBox ("Chi con ") & .Cells(i, 11)
Cells(Target.Row, 4) = .Cells(i, 11)
End If
Dim shap As Shape
For Each shap In ActiveSheet.Shapes
If InStr(1, shap.Name, "Line") > 0 Then
shap.Delete
End If
Next
K = Application.WorksheetFunction.CountIf(Range("D174178"), ">0")
If K < 5 Then
With ActiveSheet.Shapes.AddLine(190, 222 + 16.5 * (5 + K), 40, 400).Line
.DashStyle = msoLineSolid
.ForeColor.RGB = RGB(128, 1, 1)
End With
End If
End With
ActiveSheet.Protect
End Sub[/GPECODE]
Chú ý mình thay đổi code dòng 14 đến 18

 

[quoc nhat]

Xóa Shapes có tên là "Line" xóa, còn lại không
[GPECODE=vb]Private Sub Worksheet_Change(ByVal Target As Range)
If IsError([c147]) = True Then UserForm1.Show
If Intersect(Target, [A174:A178,D174178]) Is Nothing Then Exit Sub
On Error Resume Next
ActiveSheet.Unprotect
Dim i As Long
With Sheet4 'The Kho'
i = WorksheetFunction.Match(Cells(Target.Row, 1), .[b:b], 0)
If Cells(Target.Row, 4).Value > .Cells(i, 11).Value Then
MsgBox ("Chi con ") & .Cells(i, 11)
Cells(Target.Row, 4) = .Cells(i, 11)
End If
Dim shap As Shape
For Each shap In ActiveSheet.Shapes
If InStr(1, shap.Name, "Line") > 0 Then
shap.Delete
End If
Next
K = Application.WorksheetFunction.CountIf(Range("D174178"), ">0")
If K < 5 Then
With ActiveSheet.Shapes.AddLine(190, 222 + 16.5 * (5 + K), 40, 400).Line
.DashStyle = msoLineSolid
.ForeColor.RGB = RGB(128, 1, 1)
End With
End If
End With
ActiveSheet.Protect
End Sub[/GPECODE]
Chú ý mình thay đổi code dòng 14 đến 18

dạ.chân thành cảm ơn anh nhiều lắm ạ

 

[dhn46]

Mình góp vui 1 cách để bạn Vọoc nha
1- Đặt tên Line là : Line
2- Xoá dòng Code từ 13 tới 25
3 - Thay bởi Code sau:

        With Application.ActiveSheet.Shapes("Line")
            If [D197].End(3) > 0 Then
                .Top = [D179].End(3).Offset(1, 0).Top
                .Height = 16.5 * (179 - [D179].End(3).Row)
            End If
        End With

 

[ptm0412]

Mình góp vui 1 cách để bạn Vọoc nha

Cái thủ thuật này quen quen (ẹc ẹc).
Đây là cách xử lý đơn giản nhất, và code cũng đơn giản nhất khỏi vòng vèo bẫy lỗi: Vẽ 1 đường duy nhất rồi thay đổi vị trí, kích thước của nó.

 

[quoc nhat]

sao em thay code của anh vào mà không thấy cái Line nó nhúc nhích tý nào cả anh ạ, chắc là do line không nhảy được khi protecsheet

 

[le tin]

Một cách nữa để bạn tham khảo
Trường hợp chọn Line để xóa , có thể sẽ mất những Line cần giữ lại .

Private Sub Worksheet_Change(ByVal Target As Range)
If IsError([c147]) = True Then UserForm1.Show
If Intersect(Target, [A174:A178,D174178]) Is Nothing Then Exit Sub
On Error Resume Next
Dim i As Long
With Sheet4 'The Kho'
i = WorksheetFunction.Match(Cells(Target.Row, 1), .[b:b], 0)
If Cells(Target.Row, 4).Value > .Cells(i, 11).Value Then
MsgBox ("Chi con ") & .Cells(i, 11)
Cells(Target.Row, 4) = .Cells(i, 11)
End If
Dim shap As Shape
ActiveSheet.Shapes("DuongCheo").Delete
K = Application.WorksheetFunction.CountIf(Range("D174178"), ">0")
If K < 5 Then
With ActiveSheet.Shapes.AddLine(190, 222 + 16.5 * (5 + K), 40, 400)
.Line.DashStyle = msoLineSolid
.Line.ForeColor.RGB = RGB(128, 1, 1)
.Name = "DuongCheo"
End With
End If
End With
End Sub

 

[quoc nhat]

Một cách nữa để bạn tham khảo
Trường hợp chọn Line để xóa , có thể sẽ mất những Line cần giữ lại .

Private Sub Worksheet_Change(ByVal Target As Range)
If IsError([c147]) = True Then UserForm1.Show
If Intersect(Target, [A174:A178,D174178]) Is Nothing Then Exit Sub
On Error Resume Next
Dim i As Long
With Sheet4 'The Kho'
i = WorksheetFunction.Match(Cells(Target.Row, 1), .[b:b], 0)
If Cells(Target.Row, 4).Value > .Cells(i, 11).Value Then
MsgBox ("Chi con ") & .Cells(i, 11)
Cells(Target.Row, 4) = .Cells(i, 11)
End If
Dim shap As Shape
ActiveSheet.Shapes("DuongCheo").Delete
K = Application.WorksheetFunction.CountIf(Range("D174178"), ">0")
If K < 5 Then
With ActiveSheet.Shapes.AddLine(190, 222 + 16.5 * (5 + K), 40, 400)
.Line.DashStyle = msoLineSolid
.Line.ForeColor.RGB = RGB(128, 1, 1)
.Name = "DuongCheo"
End With
End If
End With
End Sub

Anh LeTin ơi! Code trên chỉ nhảy được khi UnprotecSheet thôi à.
Mà Sheet này của em phải khóa các ô không cần thiết để nhảy Tab đến các cell khác cho đỡ mất thời gian.
Anh giúp em khi ProtecSheet với

 

[quoc nhat]

sau một hồi nghiên cứu em đã tìm ra vấn đề:

Private Sub Worksheet_Change(ByVal Target As Range)
If IsError([c147]) = True Then UserForm1.Show
If Intersect(Target, [A174:A178,D174178]) Is Nothing Then Exit Sub
On Error Resume Next
Dim i As Long
With Sheet4 'The Kho'
i = WorksheetFunction.Match(Cells(Target.Row, 1), .[b:b], 0)
If Cells(Target.Row, 4).Value > .Cells(i, 11).Value Then
MsgBox ("Chi con ") & .Cells(i, 11)
Cells(Target.Row, 4) = .Cells(i, 11)
End If
ActiveSheet.Unprotect
Dim shap As Shape
ActiveSheet.Shapes("DuongCheo").Delete
K = Application.WorksheetFunction.CountIf(Range("D174: D178"), ">0")
If K < 5 Then
With ActiveSheet.Shapes.AddLine(190, 222 + 16.5 * (5 + K), 40, 400)
.Line.DashStyle = msoLineSolid
.Line.ForeColor.RGB = RGB(128, 1, 1)
.Name = "DuongCheo"
End With
End If
End With
ActiveSheet.Protect
End Sub
cái hàng chữ màu đỏ trên quyết định cho Shap nhảy khi protect sheet.
Giá mà em nghe anh Viehoai từ trước thì đỡ làm phiền các anh chị nhiều rồi
Em xin lỗi các anh chị nhé

 

[viehoai]

sau một hồi nghiên cứu em đã tìm ra vấn đề:

Private Sub Worksheet_Change(ByVal Target As Range)
If IsError([c147]) = True Then UserForm1.Show
If Intersect(Target, [A174:A178,D174178]) Is Nothing Then Exit Sub
On Error Resume Next
Dim i As Long
With Sheet4 'The Kho'
i = WorksheetFunction.Match(Cells(Target.Row, 1), .[b:b], 0)
If Cells(Target.Row, 4).Value > .Cells(i, 11).Value Then
MsgBox ("Chi con ") & .Cells(i, 11)
Cells(Target.Row, 4) = .Cells(i, 11)
End If
ActiveSheet.Unprotect
Dim shap As Shape
ActiveSheet.Shapes("DuongCheo").Delete
K = Application.WorksheetFunction.CountIf(Range("D174: D178"), ">0")
If K < 5 Then
With ActiveSheet.Shapes.AddLine(190, 222 + 16.5 * (5 + K), 40, 400)
.Line.DashStyle = msoLineSolid
.Line.ForeColor.RGB = RGB(128, 1, 1)
.Name = "DuongCheo"
End With
End If
End With
ActiveSheet.Protect
End Sub
cái hàng chữ màu đỏ trên quyết định cho Shap nhảy khi protect sheet.
Giá mà em nghe anh Viehoai từ trước thì đỡ làm phiền các anh chị nhiều rồi
Em xin lỗi các anh chị nhé

Mình đã nói ở bài 5 rồi bạn không đọc hay sao mà phải mất một hồi nghiên cứu?

 

[quoc nhat]

Mình đã nói ở bài 5 rồi bạn không đọc hay sao mà phải mất một hồi nghiên cứu?

Xin lỗi anh, em quên mất giờ mới nhớ