Viết Macro in sổ cái

[Thien]

Thân Chào cả nhà.

Mình nhờ viết giúp mình macro Chỉ in những tài khoản có số dư hoặc số phát sinh (những TK không có số dư & số phát sinh thì không được in).

Mong nhận được sự giúp đỡ.
Cảm ơn.

 

[chibi]

Bạn tham khảo file gửi kèm, tôi mới làm tạm chuyển số liệu, chưa định dạng kẻ khung, cộng cuối và phần kí.
Nhập tài khoản cần in vào D4.

 

[ThuNghi]

File của bạn nên đưa thêm DMTK, để lấy sổ cái theo dmtk (cấp 2 hay cấp 3).
Nên bổ sung thêm lấy sổ các theo ngày, từ ngày -> ngày.
Bạn thử áp dụng lọc dữ liệu bằng advance filter (bài của Kelvin), khá hay.
Hay là nghiên cứu file baocaoketoan của Mr OkeBab, very tuyệt.

 

[Thien]

Các bác không hiểu ý mình rùi.
File của mình hiện tại khi muốn in sổ cái của TK nào thì chọn số TK rùi phải chọn Chọn Nonblanks sau khi chọn mã tài khoản tạI ô D2 để in ra giấy.
Nếu có nhiều TK phát sinh thì thao tác này được lặp lại nhiều lần. Nay mình muốn nhờ viết dủm 1 cái macro làm việc đó.
Nếu in ra từng sheet, tên mỗi sheet là số TK có số liệu phát sinh.

Đây là bài toán thật mình đang làm. Rất mong nhận được sự hỗ trợ từ GPE.

PS: Mr BeBe đâu rùi.

Cảm ơn nhiều.

 

[ThuNghi]

Bạn xem thử có đúng ý bạn không? Và bỏ bớt.
Tham khảo file của Mr Be ...
Hãy down file ở bài 7, file này sai, sorry.

 

[Mr Okebab]

Các bác không hiểu ý mình rùi.
File của mình hiện tại khi muốn in sổ cái của TK nào thì chọn số TK rùi phải chọn Chọn Nonblanks sau khi chọn mã tài khoản tạI ô D2 để in ra giấy.
Nếu có nhiều TK phát sinh thì thao tác này được lặp lại nhiều lần. Nay mình muốn nhờ viết dủm 1 cái macro làm việc đó.
Nếu in ra từng sheet, tên mỗi sheet là số TK có số liệu phát sinh.

Đây là bài toán thật mình đang làm. Rất mong nhận được sự hỗ trợ từ GPE.

PS: Mr BeBe đâu rùi.

Cảm ơn nhiều.

Vì Data của bạn quá lộn xộn nên không muốn làm theo Advance Filter. Thôi thì dùng vòng lặp vậy.

Định làm theo kiểu chọn lựa in chi tiết hay tổng hợp nữa, nhưng lười quá nên thôi.

Xem rồi cho ý kiến nhé.

Thân!

 

[ThuNghi]

Bổ sung lại file kèm, có edit cho print và tạo sh
Do không có dmtk nên làm tạm vài TK, bạn nên xem sh dmtk => lấy những tk có PS.

 

[Thien]

Cảm ơn BeBe & Thunghi nhiều lắm.
Nhưng có điều giữ nguyên cấu trúc file của mình có được không.

Rất mong nhận được sự giúp đỡ.

Chân thành cảm ơn

 

[Mr Okebab]

Cảm ơn BeBe & Thunghi nhiều lắm.
Nhưng có điều giữ nguyên cấu trúc file của mình có được không.

Rất mong nhận được sự giúp đỡ.

Chân thành cảm ơn

Thì Format File của bạn vẫn giữ nguyên đấy chứ. Chẳng qua là File của bạn làm = công thức, của tụi mình chạy = VBA. Hai cái đó sẽ có những cái khác nhau.

Khi làm bằng công thức thì bạn cần phải có những cột phụ . . . , còn khi làm = VBA thì không cần. Vì thế việc có cột phụ hay không có cột phụ là không quan trọng. (thích thì bạn xóa, còn nếu không để đó cũng chẳng sao, chỉ hơi nặng máy chút thôi)

Mục đích cuối cùng là in được sổ cái tự động, in từng sổ hoặc in tất cả tài khoản có phát sinh, mình cho chọn cả từ ngày đến ngày để dễ cho bạn thôi. Không thích thì chọn từ đầu năm đến cuối năm thôi.
Để đạt được điều này thì mỗi cách làm (công thức - VBA) sẽ có những cách khác nhau.

Tất nhiên VBA có thể làm như công thức (thay đổi TK, sau đó chọn lại Auto Filter nhưng như thế thật là buồn cười vì khác nào mua xe máy về mà cứ bắt chạy tốc độ xe đạp, cái gì cũng phải có cái tối ưu của nó), còn nếu cứ muốn như công thức thì thôi .............. để công thức luôn cho xong.

Thân!

 

[ThuNghi]

Nhân cơ hội này mình học thêm 1 vài điều. Làm theo ý bạn, không sửa cái gì. Có thêm vài name. Nhớ xem qua sh dmtk, =>những cái đã in.
Cám ơn thì nhấn Thanks nhé, bao nhiêu sh bao nhiêu lần.
Máy cái này học từ Mr OkeBab cả.

 

[Thien]

Dear ThuNghi.
Mình cảm ơn bạn, bạn làm đúng ý mình rùi, chỉ có điều có cách nào không cần xem ở chế độ PrintPreview không vì như vậy mắc công nhấn close quá.
Cho mình biết bạn thêm name gì vậy? (Socai,.....)

Dear Mr BeBe
Chắc doanh số tháng này thấp lắm hả, sao giữ quá vậy nè. Mình dở VBA, nên nếu ứng dụng code của bác vào file của mình thì mình làm không được. Bạn thông cảm nhen.

Thân chào.

 

[Mr Okebab]

À, hiểu rồi, có nghĩa là khi chạy xong thì sẽ tạo ra các Sheet tương ứng với các TK phát sinh phải không ??

Không hiểu lắm, mình lại làm theo kiểu là in luôn ra các sổ cái này, không chuyển số liệu sang sheet tương ứng.

Mà tại sao lại phải chuyển sang sheet khác nhỉ, ta chỉ cần dùng 1 mẫu, sau đó sẽ in luôn ra tất cả (hoặc 1 TK) có phải là tiện không nhỉ (như File của mình)?? Chứ nếu có 40 TK có phát sinh, chắc phải tạo 40 sheet quá.

Thân!

P/S : Thu Nghi làm khá hay đó.

 

[ThuNghi]

Tìm trong code có dòng sau thì xóa đi
ActiveWindow.SelectedSheets.PrintPreview

 

[Thien]

Các bác cho hỏi thêm.
Trong trường hợp muốn in toàn bộ sổ cái các TK có số PS sang workbook mới thì chỉnh code làm sao nhì?.(hiện tại là tạo ra ngay tại sheet đang mở).

Thân chào.

 

[ThuNghi]

Theo tôi bạn làm xong, chọn hết sh cần chuyển move một cái là có ngay sh mới. (Nên làm code theo hướng này)
Theo yêu cầu của bạn tôi làm thử (học mà), hơi chậm. Tạo 1 file tên socai chung folder, bạn có thể đổi tên. Chép 2 code này vào lại file insocai

Sub TaoNhieuSC()
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.DisplayAlerts = False
End With
Dim i As Integer, Rows As Integer

S09.Visible = xlSheetVisible
Rows = S99.Cells(2, 3).Value
For i = 1 To Rows
With Application
.Calculation = xlCalculationAutomatic
End With
S03.Range("D2").Value = Range("Dmtk").Cells(i, 1).Value
With Application
.Calculation = xlCalculationManual
End With
'mo file socai cung folder
Workbooks.Open Filename:=ThisWorkbook.Path & "\socai.xls"
Call TaoSoCai
Next i
S03.Select
Selection.AutoFilter Field:=7
S09.Visible = xlSheetHidden
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.DisplayAlerts = True
End With
S03.Select
Range("d2").Select
End Sub

Sub TaoSoCai()
'Xoa tmp
Windows("insocai.xls").Activate
S09.Select
Cells.Select
Selection.ClearContents
Selection.ClearFormats
'copy socai va dan vao tmp
S03.Select
Selection.AutoFilter Field:=7, Criteria1:="<>"
Range("Socai").Select
Selection.Copy
S09.Select
Range("a1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'tao so moi & preview
S09.Copy After:=Sheets(2)
Sheets("tmp (2)").Select
'mosang va dat ten
Sheets("tmp (2)").Move Before:=Workbooks("socai.xls").Sheets(1)
Windows("socai.xls").Activate
Sheets("tmp (2)").Name = Sheets("tmp (2)").Range("D2").Value
ActiveWorkbook.Save
ActiveWindow.Close
End Sub

Bạn xem thử thế nào.

 

[Thien]

Dear thunghi!.

Cảm ơn đã giúp mình.
Cho hỏi 1 chút sao không tự tạo ra file socai.xls mà mình phải tạo file socai.xls trước khi chạy code nhỉ?. Bạn khắc phục được không?.

Thân chào

 

[ThuNghi]

Chạy thêm code này trước, dùng sự kiện open
Sub TaoWB()
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\111111.xls"
ActiveWindow.Close
End Sub

 

[Thien]

Cho mình hỏi thêm.
Mình muốn đặt name từ list (mình kiếm code trong điễn đàn không thấy) như sau:
CDPS =CDPS!$A$6:$J$129
Code =CDPS!$I$6:$I$129
DMTK =OFFSET(DMTK!$B$2:$B$101,0,0,COUNTA(DMTK!$B$2:$B$101),1)
SoCai ='So cai'!$A$1:$F$1014

cột 1 là CDPS
cột 2 là =CDPS!$A$6:$J$129

code sẽ dò từng dòng trong sheet chứa list muốn tạo name & tạo ra name

Thân chào

 

[ThuNghi]

Public Sub Add_name()
Dim i As Long 'NVSON
For i = 1 To Range("rngName").Rows.Count
ActiveWorkbook.Names.Add Name:=Range("rngName").Cells(i, 1).Value, RefersTo:="=" & Range("rngReplace").Cells(i, 1).Value
Next i
End Sub
Public Sub ThayThe()
On Error Resume Next 'NVSON
Dim i As Long, StrText As String
Dim KQ
For i = 1 To ActiveWorkbook.Names.Count
Err.Clear
KQ = WorksheetFunction.Match(ActiveWorkbook.Names(i, 1, 1).NameLocal, Range("rngName"), 0)
If Err.Number = 0 Then
StrText = WorksheetFunction.Index(Range("rngReplace"), KQ, 1)
ActiveWorkbook.Names.Add Name:=ActiveWorkbook.Names(i, 1, 1).NameLocal, RefersTo:="=" & StrText
End If
Next i
End Sub
Sub Link_Paste_Names()
On Error GoTo thoat 'NVSON
Dim row1 As Integer, col1 As Integer
Dim i As Integer
row1 = ActiveCell.Row
col1 = ActiveCell.Column
For i = 1 To ActiveWorkbook.Names.Count
Cells(row1 + i - 1, col1) = ActiveWorkbook.Names(i, 1, 1).NameLocal
Cells(row1 + i - 1, col1 + 1) = Mid(ActiveWorkbook.Names(i, 1, 1).RefersTo, 2)
Cells(row1 + i - 1, col1 + 1).Select
Selection.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=ActiveWorkbook.Names(i, 1, 1).RefersTo
Next i
thoat:
End Sub

Cái này của NVSon

 

[Thien]

chẳn hiểu sao lại báo lỗi dòng này.

ActiveWorkbook.Names.Add Name:=Range("rngName").Cells(i, 1).Value, RefersTo:="=" & Range("rngReplace").Cells(i, 1).Value

Thân chào