giúp đỡ gạch đường chéo hóa đơn tự động trên excel. (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Cháu không hiểu VBA nên chỉ biết copy sẵn, cháu thấy có người hướng dẫn thêm code này ở sheet cần gạch chéo:

Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Range("E3"), Range(Target.Address)) Is Nothing Then
    Call KeDuong
End If
End Sub

nhưng cháu thấy không chạy, mong chú và mọi người làm hộ cháu với ạ
Sự kiện Worksheet_Change chỉ định tại một ô nào đó thì bạn chỉ cần viết như này:
PHP:
If Target.Address = "$E$3" Then
Call KeDuong
End If
Khi bạn cần sự kiện Worksheet_Change ở một vùng nào đó - Vung_Can_Xet (nhiều hơn 1 cell) thì dùng tới Intersect (giao giữa các Range)
PHP:
If Not Application.Intersect(Target, Vung_Can_Xet) Is Nothing Then
 
Phương thức AddLine có cú pháp:
Mã:
AddLine( BeginX, BeginY, EndX, EndY)
Vậy chỉ cần xác định celBegin và celEnd rồi gán vào là xong, không cần Left, Top, Width, Height gì đâu (dù không có sai)
Đại khái mình viết vầy:
Mã:
Sub DrawAcross()
  Const SHPNAME = "LineAcross"
  Dim wks       As Worksheet
  Dim celBegin  As Range
  Dim celEnd    As Range
  Set wks = ActiveSheet
  On Error Resume Next
  wks.Shapes(SHPNAME).Delete
  On Error GoTo 0
  Set celEnd = wks.Range("I21")
  Set celBegin = wks.Range("C23").End(xlUp)
  If celBegin.Row < 20 Then  ''<--- Nếu dữ liệu đã được lấp đầy thì không cần kẻ đường
    Set celBegin = celBegin.Offset(1, -1)
    With wks.Shapes.AddLine(celBegin.Left, celBegin.Top, celEnd.Left, celEnd.Top)
      .Name = SHPNAME
      .Line.ForeColor.RGB = vbBlack  ''<--- Màu tùy ý
      .Line.Weight = 0.5                      ''<--- Độ dày tùy ý
    End With
  End If
End Sub
Cám ơn bác, đúng cái em đang cần!
 
Web KT

Bài viết mới nhất

Back
Top Bottom