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

phamsacyb · 19/8/18

mình lấy dữ liệu từ bảng kê cột "PN-Mã vật tư" và cột "PX-Mã vật tư", sau đó mình paste( dán) vào cột " Mã số" của sheet "PNKNamho","PXKNamho", mình muốn gạch đường chéo hóa đơn tự động, mình sẽ gửi flie excel và một file video mô tả cho các bạn dễ hiểu nhé. có bạn nào biết thì viết code VBA giúp mình với nhé. các bạn viết trực tiếp trên file excel mình gửi nhé, để mình làm mẫu luôn. hì. mình xin cám ơn.

nghiaphuc · 19/8/18

phamsacyb đã viết:
mình lấy dữ liệu từ bảng kê cột "PN-Mã vật tư" và cột "PX-Mã vật tư", sau đó mình paste( dán) vào cột " Mã số" của sheet "PNKNamho","PXKNamho", mình muốn gạch đường chéo hóa đơn tự động, mình sẽ gửi flie excel và một file video mô tả cho các bạn dễ hiểu nhé. có bạn nào biết thì viết code VBA giúp mình với nhé. các bạn viết trực tiếp trên file excel mình gửi nhé, để mình làm mẫu luôn. hì. mình xin cám ơn.

Code thế này:

Mã:

Sub KeDuong()
    Dim Cll As Range, S As String
    Set Cll = Sheet5.[B21]
    Do While Len(Cll.Offset(-1)) = 0
        Set Cll = Cll.Offset(-1)
    Loop
    On Error Resume Next
    S = Sheet5.Shapes("DuongKe").Name
    If S = "" Then
        Sheet5.Shapes.AddLine(1, 1, 2, 2).Name = "DuongKe"
        Sheet5.Shapes("DuongKe").Line.ForeColor.RGB = RGB(0, 0, 0)
    End If
    On Error GoTo 0
    With Sheet5.Shapes("DuongKe")
        If Cll.Row < 21 Then
            .Top = Cll.Top
            .Left = Cll.Left
            .Height = Range(Cll, Sheet5.[H20]).Height
            .Width = Range(Cll, Sheet5.[H20]).Width
            .Visible = msoTrue
        Else
            .Visible = msoFalse
        End If
    End With
End Sub

SA_DQ · 19/8/18

Ở trang "PXK. . ." ta có macro sự kiện này

Mã:

Private Sub Worksheet_Activate()
 Rows("9:20").Hidden = False
End Sub

Ở Module1 ta có macro với tổ hợp fím nóng là {CTRL}+{SHIRT}+A

PHP:

Sub AnDong()
 Dim J As Integer
 Application.ScreenUpdating = False
 For J = 9 To 20
    If Cells(J, "C").Value = "" Then
        Rows(J & ":" & J).Hidden = True
    End If
 Next J
 Application.ScreenUpdating = True
End Sub

ndu96081631 · 19/8/18

nghiaphuc đã viết:

Code thế này:

Mã:

Sub KeDuong()
    Dim Cll As Range, S As String
    Set Cll = Sheet5.[B21]
    Do While Len(Cll.Offset(-1)) = 0
        Set Cll = Cll.Offset(-1)
    Loop
    On Error Resume Next
    S = Sheet5.Shapes("DuongKe").Name
    If S = "" Then
        Sheet5.Shapes.AddLine(1, 1, 2, 2).Name = "DuongKe"
        Sheet5.Shapes("DuongKe").Line.ForeColor.RGB = RGB(0, 0, 0)
    End If
    On Error GoTo 0
    With Sheet5.Shapes("DuongKe")
        If Cll.Row < 21 Then
            .Top = Cll.Top
            .Left = Cll.Left
            .Height = Range(Cll, Sheet5.[H20]).Height
            .Width = Range(Cll, Sheet5.[H20]).Width
            .Visible = msoTrue
        Else
            .Visible = msoFalse
        End If
    End With
End Sub

Dùng End(xlUp) theo cột C sẽ không cần phải Do...Loop (vì cột C chỉ có dữ liệu thô)

nghiaphuc · 19/8/18

ndu96081631 đã viết:
Dùng End(xlUp) theo cột C sẽ không cần phải Do...Loop (vì cột C chỉ có dữ liệu thô)

Hì hì... Đôi khi đao to búa lớn cho nó oai anh ạ. Em cũng đã nghĩ đến End(XlUp) rồi mà lại không nghĩ làm trên cột C.
Cảm ơn anh!

phamsacyb · 19/8/18

bạn nghiaphuc, bên phiếu nhập kho không có nút kẻ đường để mình ấn nhỉ, cái này chỉ biết ăn sẵn thôi, bên phiếu xuất kho thì có rồi, bạn làm giúp mình bên phiếu nhập kho với.

Bài đã được tự động gộp: 19/8/18

mình không học về VBA mà, nên chỉ biết ăn sẵn thôi, nên để tự mày mò thì chịu thôi, ko biết bắt đầu từ đâu cả, nghiaphuc làm giúp nốt bên phiếu Nhập kho giúp mình với nhé. hì

nghiaphuc · 19/8/18

phamsacyb đã viết:
mình không học về VBA mà, nên chỉ biết ăn sẵn thôi, nên để tự mày mò thì chịu thôi, ko biết bắt đầu từ đâu cả, nghiaphuc làm giúp nốt bên phiếu Nhập kho giúp mình với nhé. hì

Sửa lại code một chút, khỏi cần cái nút kia luôn, tại 2 sheet này, khi nào bạn cần kẻ đường thì nhấn tổ hợp phím Ctrl+Shift+K là nó kẻ luôn.

Mã:

Sub KeDuong()
    'Shortcut key: Cltr+Shift+K
    Dim fCll As Range, lCll As Range, S As String
    If InStr(1, ".PNKN.PXKN.", Left(ActiveSheet.Name, 4)) = 0 Then Exit Sub
    Set fCll = [C24].End(xlUp).Offset(1, -1)
    Set lCll = [H:H].Find("*", [H1], , , , xlPrevious).Offset(-5)
    On Error Resume Next
    S = ActiveSheet.Shapes("DuongKe").Name
    If S = "" Then
        ActiveSheet.Shapes.AddLine(1, 1, 2, 2).Name = "DuongKe"
        ActiveSheet.Shapes("DuongKe").Line.ForeColor.RGB = RGB(0, 0, 0)
    End If
    On Error GoTo 0
    With ActiveSheet.Shapes("DuongKe")
        If fCll.Row < 21 Then
            .Top = fCll.Top
            .Left = fCll.Left
            .Height = Range(fCll, lCll).Height
            .Width = Range(fCll, lCll).Width
            .Visible = msoTrue
        Else
            .Visible = msoFalse
        End If
    End With
End Sub

ndu96081631 · 19/8/18

nghiaphuc đã viết:

Sửa lại code một chút, khỏi cần cái nút kia luôn, tại 2 sheet này, khi nào bạn cần kẻ đường thì nhấn tổ hợp phím Ctrl+Shift+K là nó kẻ luôn.

Mã:

Sub KeDuong()
    'Shortcut key: Cltr+Shift+K
    Dim fCll As Range, lCll As Range, S As String
    If InStr(1, ".PNKN.PXKN.", Left(ActiveSheet.Name, 4)) = 0 Then Exit Sub
    Set fCll = [C24].End(xlUp).Offset(1, -1)
    Set lCll = [H:H].Find("*", [H1], , , , xlPrevious).Offset(-5)
    On Error Resume Next
    S = ActiveSheet.Shapes("DuongKe").Name
    If S = "" Then
        ActiveSheet.Shapes.AddLine(1, 1, 2, 2).Name = "DuongKe"
        ActiveSheet.Shapes("DuongKe").Line.ForeColor.RGB = RGB(0, 0, 0)
    End If
    On Error GoTo 0
    With ActiveSheet.Shapes("DuongKe")
        If fCll.Row < 21 Then
            .Top = fCll.Top
            .Left = fCll.Left
            .Height = Range(fCll, lCll).Height
            .Width = Range(fCll, lCll).Width
            .Visible = msoTrue
        Else
            .Visible = msoFalse
        End If
    End With
End Sub

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

nghiaphuc · 19/8/18

ndu96081631 đã viết:
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 Set celBegin = celBegin.Offset(1, -1) With wks.Shapes.AddLine(celBegin.Left, celBegin.Top, celEnd.Left, celEnd.Top) .Name = SHPNAME .Line.ForeColor.RGB = vbBlack .Line.Weight = 0.5 End With End If End Sub

Có thể sửa lại một chút thì đẹp hơn:

Mã:

wks.Shapes.AddLine(celBegin.Left, celBegin.Top, celEnd.Left + celEnd.Width, celEnd.Top + celEnd.Height)

ndu96081631 · 19/8/18

nghiaphuc đã viết:
Có thể sửa lại một chút thì đẹp hơn:

Mã:

wks.Shapes.AddLine(celBegin.Left, celBegin.Top, celEnd.Left + celEnd.Width, celEnd.Top + celEnd.Height)

Hiểu em trai nói gì luôn. Ẹc... Ẹc...
Nhưng mà ở phía trên tôi đã Set celEnd = wks.Range("I21") rồi, Tức là trúng phóc luôn nên không cần "gia giảm" gì cả

nghiaphuc · 19/8/18

ndu96081631 đã viết:
Hiểu em trai nói gì luôn. Ẹc... Ẹc...
Nhưng mà ở phía trên tôi đã Set celEnd = wks.Range("I21") rồi, Tức là trúng phóc luôn nên không cần "gia giảm" gì cả

Bên kia phải là I24 lận anh trai ơi! Lêu lêu...

ndu96081631 · 19/8/18

nghiaphuc đã viết:
Bên kia phải là I24 lận anh trai ơi! Lêu lêu...

Thì bên nào làm theo bên nấy. Tôi làm file ở bài 1 mà.
Mấy bài sau nếu có thay đổi gì đó, chỉ cần sửa celBegin và celEnd là xong

be_09 · 20/8/18

phamsacyb đã viết:
mình lấy dữ liệu từ bảng kê cột "PN-Mã vật tư" và cột "PX-Mã vật tư", sau đó mình paste( dán) vào cột " Mã số" của sheet "PNKNamho","PXKNamho", mình muốn gạch đường chéo hóa đơn tự động, mình sẽ gửi flie excel và một file video mô tả cho các bạn dễ hiểu nhé. có bạn nào biết thì viết code VBA giúp mình với nhé. các bạn viết trực tiếp trên file excel mình gửi nhé, để mình làm mẫu luôn. hì. mình xin cám ơn.

Thêm cho bạn 1 cách khác.
1/ Code cho phiếu xuất kho:

Mã:

Sub GPE_XuatKho()
    Dim L1, L2 As Range
    Dim shp As Shape
    Set L1 = Range("C9").End(xlDown).Offset(1, -1)
    Set L2 = Range("I32")

    With ActiveSheet
        On Error Resume Next
        .Shapes.Range(Array("Line")).Delete
        Set shp = ActiveSheet.Shapes.AddConnector(1, L1.Left, L1.Top, L2.Left, L2.Top)
        shp.Line.Visible = msoArrowheadOpen
        shp.Name = "Line"
    End With
End Sub

2/ Phiếu nhập kho, bạn chỉ cần thay chỗ này (xem hình):
C9 = C12
I32 = I24

phamsacyb · 20/8/18

mình cám ơn tất cả các bạn nhé. mình đã làm được rồi. yêu các bạn nhiều lắm, hì hì.

dephetnoi · 20/8/18

phamsacyb đã viết:
mình cám ơn tất cả các bạn nhé. mình đã làm được rồi. yêu các bạn nhiều lắm, hì hì.

17 tuổi mà kêu mấy bác, mấy thầy bằng bạn? Hiii

phamsacyb · 20/8/18

dephetnoi đã viết:
17 tuổi mà kêu mấy bác, mấy thầy bằng bạn? Hiii

cháu,em.. sơ xuất chút cháu, em cám ơn các bác các thầy các anh nhé,

hoangtuaotrang_hp_vn · 13/9/18

nghiaphuc đã viết:

Sửa lại code một chút, khỏi cần cái nút kia luôn, tại 2 sheet này, khi nào bạn cần kẻ đường thì nhấn tổ hợp phím Ctrl+Shift+K là nó kẻ luôn.

Mã:

Sub KeDuong()
    'Shortcut key: Cltr+Shift+K
    Dim fCll As Range, lCll As Range, S As String
    If InStr(1, ".PNKN.PXKN.", Left(ActiveSheet.Name, 4)) = 0 Then Exit Sub
    Set fCll = [C24].End(xlUp).Offset(1, -1)
    Set lCll = [H:H].Find("*", [H1], , , , xlPrevious).Offset(-5)
    On Error Resume Next
    S = ActiveSheet.Shapes("DuongKe").Name
    If S = "" Then
        ActiveSheet.Shapes.AddLine(1, 1, 2, 2).Name = "DuongKe"
        ActiveSheet.Shapes("DuongKe").Line.ForeColor.RGB = RGB(0, 0, 0)
    End If
    On Error GoTo 0
    With ActiveSheet.Shapes("DuongKe")
        If fCll.Row < 21 Then
            .Top = fCll.Top
            .Left = fCll.Left
            .Height = Range(fCll, lCll).Height
            .Width = Range(fCll, lCll).Width
            .Visible = msoTrue
        Else
            .Visible = msoFalse
        End If
    End With
End Sub

bác ơi, có cách nào để code tự chạy khi nội dung 1 ô bất kỳ thay đổi không? (giả sử: nội dung ô E3 thay đổi)
mà ko phải bấm cái gì ko ạ?

SA_DQ · 13/9/18

hoangtuaotrang_hp_vn đã viết:
bác ơi, có cách nào để code tự chạy khi nội dung 1 ô bất kỳ thay đổi không? (giả sử: nội dung ô E3 thay đổi)
mà ko phải bấm cái gì ko ạ?

Macro sự kiện tại ~ [E3] sẽ trợ giúp cho bạn điều bạn muốn!

hoangtuaotrang_hp_vn · 13/9/18

SA_DQ đã viết:
Macro sự kiện tại ~ [E3] sẽ trợ giúp cho bạn điều bạn muốn!

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 ạ

SA_DQ · 14/9/18

Thì bạn nhờ tác giả #2 í, Xem lại đi.

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

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

Thành viên mới

File đính kèm

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

File đính kèm

/(hông là gì!

File đính kèm

Huyền thoại GPE

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

Thành viên mới

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

File đính kèm

Huyền thoại GPE

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

Huyền thoại GPE

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

Huyền thoại GPE

Biên Hòa, Đồng Nai

Thành viên mới

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

Thành viên mới

Thành viên tích cực

/(hông là gì!

Thành viên tích cực

/(hông là gì!

Đếm ngược thời gian