Dùng marco gán cho nút Button để tạo lệnh in (2 người xem)

[truckhoa2006]

Em muốn in nhiều phiếu lương có trong danh sách được tạo ra.
Em đã làm 1 file thử, và dùng marco ghi lại kết quả đúng như ý định của em là 8 phần, còn 2 phần là chưa được.
Vì khi em tạo ra nút này em nghĩ nó sẽ tự động làm tương tự phần còn lại.

Thao tác em làm như sau:
Em tạo 1 nút Button trên Sheet 1 và bật Record , em nhấn vào nút button , chọn tiêu đề và nội dung dòng 1 ( Số thứ tự dòng 1) , rồi em paste vào Sheet 2 ( Paste Specail - Transpose) chuyển từ dòng sang cột, xong èm làm tương tự với 3 dòng tiếp theo với dòng tiêu đề và dòng 2 ( STT 2) , tưng tự đến dòng STT 4.
Em Stop record marco. Save , rồi nhấn thử, thì nó chỉ ra 4 ô em đã làm, vậy là đúng rồi. Nhưng chẳng lẽ em phải copy đến hết bảng sao, lỡ như có dòng không có dữ liệu thì sao.
Mong mọi người góp ý kiến, làm tới cái này nhứ hết cả cái đầu luôn
Mong thầy ndu và các anh chị giúp chỉ dùm em cái sai, và cái thiếu. EM cám ơn.

 

[truckhoa2006]

Như cách của anh này
http://www.giaiphapexcel.com/forum/...ch-In-hàng-loạt-với-dữ-liệu-có-sẵn-trên-Excel
rất hay nhưng chỉ áp dụng cho 1 sheet duy nhất. DO đó em phải tự mày mò thêm 1 sheet, do của dhn46 là sự kết hợp của 4 sheet lại mới ra, nên em muốn kết hợp thêm 1 sheet riêng biệt. CÁm ơn mọi người đọc tin.

 

[hanhpptc]

Em muốn in nhiều phiếu lương có trong danh sách được tạo ra.
Em đã làm 1 file thử, và dùng marco ghi lại kết quả đúng như ý định của em là 8 phần, còn 2 phần là chưa được.
Vì khi em tạo ra nút này em nghĩ nó sẽ tự động làm tương tự phần còn lại.

Thao tác em làm như sau:
Em tạo 1 nút Button trên Sheet 1 và bật Record , em nhấn vào nút button , chọn tiêu đề và nội dung dòng 1 ( Số thứ tự dòng 1) , rồi em paste vào Sheet 2 ( Paste Specail - Transpose) chuyển từ dòng sang cột, xong èm làm tương tự với 3 dòng tiếp theo với dòng tiêu đề và dòng 2 ( STT 2) , tưng tự đến dòng STT 4.
Em Stop record marco. Save , rồi nhấn thử, thì nó chỉ ra 4 ô em đã làm, vậy là đúng rồi. Nhưng chẳng lẽ em phải copy đến hết bảng sao, lỡ như có dòng không có dữ liệu thì sao.
Mong mọi người góp ý kiến, làm tới cái này nhứ hết cả cái đầu luôn
Mong thầy ndu và các anh chị giúp chỉ dùm em cái sai, và cái thiếu. EM cám ơn.

Mình cố tình để code dài để bạn dễ hiểu nhé

 

[truckhoa2006]

Đúng ý em rồi. Cám ơn anh nhiều nhiều nha, để em ngâm cứu áp dụng qua file em thử xem sao.

Em xin có 1 ý kiến nữa nha.
Em thấy cả anh và anh dhn46 đều lấy Số thứ tự làm điểm mốc để cho ra bảng in như ý, vậy nếu không dùng SỐ thứ tự mà dùng Mã nhân viên làm cột mốc được không anh.
Cám ơn anh, em chỉ hỏi cho biết thôi.

 

[hanhpptc]

Đúng ý em rồi. Cám ơn anh nhiều nhiều nha, để em ngâm cứu áp dụng qua file em thử xem sao.

Em xin có 1 ý kiến nữa nha.
Em thấy cả anh và anh dhn46 đều lấy Số thứ tự làm điểm mốc để cho ra bảng in như ý, vậy nếu không dùng SỐ thứ tự mà dùng Mã nhân viên làm cột mốc được không anh.
Cám ơn anh, em chỉ hỏi cho biết thôi.

Mình chỉ lấy dòng cuối có dữ liệu tại cột A sheet 1 để in hết bảng thôi, không lấy số thứ tự
Bạn thử lấy cột khác cũng được

 

[truckhoa2006]

Anh xem lại giúp em nha.
Mặc dù em đã làm giống như đoạn code của anh cho rồi mà nó không ra.
Em đã đổi tên từ cái tên của nút button đến cái tên của sheet cho giống của em mà nó không ra. Dù đã kiểm tra 2 đoạn code của anh và của em rồi mà nó cũng không ra đúng, nó chạy tùm lum.
Mong anh xem lại và chỉ cái sai cho em nha.
Cám ơn anh nhiều.

 

[hanhpptc]

Anh xem lại giúp em nha.
Mặc dù em đã làm giống như đoạn code của anh cho rồi mà nó không ra.
Em đã đổi tên từ cái tên của nút button đến cái tên của sheet cho giống của em mà nó không ra. Dù đã kiểm tra 2 đoạn code của anh và của em rồi mà nó cũng không ra đúng, nó chạy tùm lum.
Mong anh xem lại và chỉ cái sai cho em nha.
Cám ơn anh nhiều.

Bạn muốn in cái gì ra, ở đây là Mã, tên, chức vụ, tổng ngày công

 

[hanhpptc]

Còn đây là theo mình phỏng đoán: Mã, Tên, Cvụ, Tổng tiền, Đã nhận, Còn nhận

 

[truckhoa2006]

Cho mình hỏi ý nghĩa của các dòng này có phải như thế này không nha:

Sub INPHIEULUONG() : Tên của Nút Button
'
' INPHIEULUONG Macro
'

'
Application.ScreenUpdating = False
DC = Sheet5.Range("A65536").End(xlUp).Row : Đặt DC là ký hiệu của Sheet 5 cột A
If DC < 5 Then DC = 5 : Điều kiện để xác định số cột cần lấy
Sheet6.Range("B3:F65536").ClearContents : Vùng cần xuất hiện trong Sheet 6
k = 5 : Đặt k = 5 để khi lấy thêm nội dung sẽ +1
For i = 5 To DC Step 2 : i tương tự k
'Tieu de
Sheet6.Range("B" & k).Value = Sheet5.Range("B4").Value : Tên tiêu đề ở B4 sheet 5 sẽ xuất hiện ở B5 sheet 6
Sheet6.Range("B" & k + 1).Value = Sheet5.Range("C4").Value : Tên tiêu đề ở C4 sheet 5 sẽ xuất hiện ở B6 sheet 6
Sheet6.Range("B" & k + 2).Value = Sheet5.Range("D4").Value : Tên tiêu đề ở D4 sheet 5 sẽ xuất hiện ở B7 sheet 6
Và đoạn code này được viết trên nút button ( trong Module)

Những cái khác tương tự, mình hiểu như vậy là đúng chưa.
Cám ơn bạn.

 

[hanhpptc]

Bạn cần tìm hiểu thêm nhé:
Application.ScreenUpdating = False: Không cho màn hình nhấp nháy khi lệnh in (Button2)
DC = Sheet5.Range("A65536").End(xlUp).Row : Đặt DC là số hiệu dòng cuối cùng của Sheet 5 cột A (DC là dòng cuối)
If DC < 5 Then DC = 5 : DC phải ít nhất là 5, phòng trường hợp bảng lương không có dữ liệu
Sheet6.Range("B3:F65536").ClearContents : Xó toàn bộ dữ liệu cũ Sheet 6 trước khi in mới
k = 5 : Đặt k = 5 là dòng đầu tiên cần lấy
For i = 5 To DC Step 2 : Vòng lặp từ dòng 5 đến hết bảng lương (DC). Lưu ý Step 2 là do in ra 2 phân cột (Mối dòng có 02 cán bộ)
'Tieu de
Sheet6.Range("B" & k).Value = Sheet5.Range("B4").Value : Tên tiêu đề ở B4 sheet 5 sẽ xuất hiện ở B5 sheet 6

 

[truckhoa2006]

Bạn cần tìm hiểu thêm nhé:
Application.ScreenUpdating = False: Không cho màn hình nhấp nháy khi lệnh in (Button2)
DC = Sheet5.Range("A65536").End(xlUp).Row : Đặt DC là số hiệu dòng cuối cùng của Sheet 5 cột A (DC là dòng cuối)
If DC < 5 Then DC = 5 : DC phải ít nhất là 5, phòng trường hợp bảng lương không có dữ liệu
Sheet6.Range("B3:F65536").ClearContents : Xó toàn bộ dữ liệu cũ Sheet 6 trước khi in mới
k = 5 : Đặt k = 5 là dòng đầu tiên cần lấy
For i = 5 To DC Step 2 : Vòng lặp từ dòng 5 đến hết bảng lương (DC). Lưu ý Step 2 là do in ra 2 phân cột (Mối dòng có 02 cán bộ)
'Tieu de
Sheet6.Range("B" & k).Value = Sheet5.Range("B4").Value : Tên tiêu đề ở B4 sheet 5 sẽ xuất hiện ở B5 sheet 6

Mình đã làm được rồi, cám bạn nhiều nhiều nha.
Thêm 1 phát sinh nữa nha, có cũng được mà không có cũng không sao:
Nếu mình muốn đóng khung cho những phiếu in lương đó thì mình sẽ kẻ sẵn ô bên sheet 6 rồi khi nhấn thì data sẽ tự vào .
Hay có thể viết thêm phần kẻ ô vảo được không?

Làm xong cái này phát sinh cái kia. Hihi, làm phiền bạn nữa rồi, Nếu không được cũng không sao mình sẽ kẻ ô sẵn cũng được. Cám ơn bạn nha

 

[truckhoa2006]

Mình dùng
[h=1]Conditional Formatting[/h]Ổ hết rồi.

 

[truckhoa2006]

1. Mình đã làm theo code của hanhpptc cho, mình đã ứng ứng vào rồi rất ngon rất ổn. Nhưng nếu mình dùng theo cách đó thì mỗi lần copy code đó cho mình sheet khác nữa thì rất dễ xảy ra lỗi. Mình không nói là mình không sửa được, nhưng ý mình muốn làm sao cho cái code đó ngắn lại được không, mình biết là các bạn biết cách . Nên mình xin các bạn rút ngắn lệnh in lại cho dễ nhìn được không.?

2. Và cứ mỗi lần mình tạo 1 nút Button mới trên 1 sheet mới thì 1 Module mới lại xuất hiện. Vậy mình có thể cho tất cả các code nút button ( của lệnh in) của những Module đó vào chung 1 Module được không ?

Cám ơn các bạn rất nhiều.

 

[sealand]

Đây là cách làm cho ngắn, nhưng còn chậm quá. Dùng mảng rẹt cái xong

Sub MAKEPL()
Dim Dc As Long, Cl(), i, j, k
Application.ScreenUpdating = False
Dc = Sheet5.Range("A65536").End(xlUp).Row
If Dc < 5 Then Exit Sub
Sheet6.Range("B3:F65536").ClearContents
Cl = Array(2, 3, 4, 12, 13, 14)
k = 5
For i = 5 To Dc Step 2
For j = 0 To 5
Sheet6.Range("B" & k + j).Value = Sheet5.Cells(4, Cl(j)).Value    'Tieu de
Sheet6.Range("C" & k + j).Value = Sheet5.Cells(i, Cl(j)).Value
Sheet6.Range("E" & k + j).Value = Sheet5.Cells(4, Cl(j)).Value    'Tieu de
Sheet6.Range("F" & k + j).Value = Sheet5.Cells(i + 1, Cl(j)).Value
Next j
k = k + 7
Next i
Application.ScreenUpdating = True
Sheet6.Select
End Sub

 

[sealand]

Đây là Code dùng mảng cho tốc độ rất nhanh:

Sub MAKEPL1()
Dim Dc As Long, Cl(), i, j, k
Dim Tm, Td, Kq()
Dc = Sheet5.Range("A65536").End(xlUp).Row
If Dc < 5 Then Exit Sub
ReDim Kq(Int(Dc / 2) * 7 + 7, 1 To 6)
Tm = Sheet5.Range("A5:O" & Dc)
Td = Sheet5.[A4:O4]
k = 1
Cl = Array(2, 3, 4, 12, 13, 14)
For i = 1 To UBound(Tm, 1) Step 2
For j = 0 To 5
Kq(k + j, 2) = Td(1, Cl(j))
Kq(k + j, 3) = Tm(i, Cl(j))
Kq(k + j, 5) = Td(1, Cl(j))
Kq(k + j, 6) = Tm(i + 1, Cl(j))
Next j
k = k + 7
Next i
Sheet6.[A1:F65000].ClearContents
Sheet6.[A5].Resize(UBound(Kq, 1), UBound(Kq, 2)) = Kq
Sheet6.Select
End Sub

 

[truckhoa2006]

Đây là Code dùng mảng cho tốc độ rất nhanh:

Sub MAKEPL1()
Dim Dc As Long, Cl(), i, j, k
Dim Tm, Td, Kq()
Dc = Sheet5.Range("A65536").End(xlUp).Row
If Dc < 5 Then Exit Sub
ReDim Kq(Int(Dc / 2) * 7 + 7, 1 To 6)
Tm = Sheet5.Range("A5:O" & Dc)
Td = Sheet5.[A4:O4]
k = 1
Cl = Array(2, 3, 4, 12, 13, 14)
For i = 1 To UBound(Tm, 1) Step 2
For j = 0 To 5
Kq(k + j, 2) = Td(1, Cl(j))
Kq(k + j, 3) = Tm(i, Cl(j))
Kq(k + j, 5) = Td(1, Cl(j))
Kq(k + j, 6) = Tm(i + 1, Cl(j))
Next j
k = k + 7
Next i
Sheet6.[A1:F65000].ClearContents
Sheet6.[A5].Resize(UBound(Kq, 1), UBound(Kq, 2)) = Kq
Sheet6.Select
End Sub

Cám ơn anh nhiều lắm.
Đúng là siêu nhanh. EM muốn hiểu rõ hơn về cá đoạn sub đó anh có thể bổ xung thêm cho em nha. EM hiểu các dòng sub đó như thế này, anh xem có đúng không nha.:

Sub MAKEPL1() ( Tên của bút button)
Dim Dc As Long, Cl(), i, j, k ( Cái này em không biết)
Dim Tm, Td, Kq() (Đặt ký hiệu : Tm là nội dung; Td là tiêu đề; kq là kết quả)
Dc = Sheet5.Range("A65536").End(xlUp).Row (Vòng lặp tốt nhất không chỉnh sửa gì hết)
If Dc < 5 Then Exit Sub
ReDim Kq(Int(Dc / 2) * 7 + 7, 1 To 6) ( Cái này em không biết)
Tm = Sheet5.Range("A5:O" & Dc) ( Tại sheet 5 sẽ bắt đầu lấy dữ liệu từ cột A5 đến cột O đến dòng cuối cùng)
Td = Sheet5.[A4:O4] ( Xác định lấy tiêu đề từ A4 đến O4)
k = 1 ( Không biết nhưng không được thay đổi)
Cl = Array(2, 3, 4, 12, 13, 14) ( Biểu thị cho vị trí cột số ; Vd: 2 là cột B, 3 ;à cột C.........)
For i = 1 To UBound(Tm, 1) Step 2 ( Không biết nhưng không được thay đổi)
For j = 0 To 5
Kq(k + j, 2) = Td(1, Cl(j))
Kq(k + j, 3) = Tm(i, Cl(j))
Kq(k + j, 5) = Td(1, Cl(j))
Kq(k + j, 6) = Tm(i + 1, Cl(j))
Next j
k = k + 7
Next i
Sheet6.[A1:F65000].ClearContents ( Xóa tất cả nội dung ở sheet này trước khi đặt nội dung mới vào)
Sheet6.[A5].Resize(UBound(Kq, 1), UBound(Kq, 2)) = Kq ( Nội dung cần xuất sẽ xuất hiện bắt đầu từ ô A5)
Sheet6.Select ( Chọn sheet 6)
End Sub

Cl = Array(2, 3, 4, 12, 13, 14) : Em đã tăng từ 6 cột lên 13 cột , có nghĩa là tăng thêm 7 cột : 5,6,7,8,9,10,11. Nhưng không ra , vẫn ra 6 cột thôi.
Anh xem em hiểu vậy có được không, và những chỗ em không ghi thì do em không hiểu để áp dụng vào file gốc của em.
Rất mong anh tận tình giúp đỡ.
Cám ơn anh.

 

[truckhoa2006]

Em hiểu hết rồi ứng dụng được rồi.
Làm gần xong rùi, 4 sheet , nhập đoạn code anh cho và sửa lại cho dùng được , thì làm được có 3 sheet còn 1 sheet không biết bị sao mà nó cứ báo lỗi , ngay khúc này
Kq(k + j, 2) = Td(1, Cl(j))

Hoặc khúc này
Kq(k + j, 6) = Tm(i + 1, Cl(j))

Không biết nó có ý nghĩ gì nữa 3 sheet kia ngon lành, còn sheet 4 thì die rùi

 

[Quang_Hải]

Em hiểu hết rồi ứng dụng được rồi.
Làm gần xong rùi, 4 sheet , nhập đoạn code anh cho và sửa lại cho dùng được , thì làm được có 3 sheet còn 1 sheet không biết bị sao mà nó cứ báo lỗi , ngay khúc này
Kq(k + j, 2) = Td(1, Cl(j))

Hoặc khúc này
Kq(k + j, 6) = Tm(i + 1, Cl(j))

Không biết nó có ý nghĩ gì nữa 3 sheet kia ngon lành, còn sheet 4 thì die rùi

Nếu không rành về code thì lấy code này mà vọc. Đơn giản và căn bản nhất.

Sub INPHIEULUONG1()
Dim i As Long, INHD As Worksheet, INLUONGHD As Worksheet
Set INHD = Sheets("INHD")
Set INLUONGHD = Sheets("INLUONGHD")
For i = 5 To INLUONGHD.[A65536].End(3).Row Step 2
    INHD.[B65536].End(3).Offset(2).Resize(13) = Application.Transpose(INLUONGHD.[B4:N4])
    INHD.[C65536].End(3).Offset(2).Resize(13) = Application.Transpose(INLUONGHD.Range(("B" & i), "N" & i))
    INHD.[E65536].End(3).Offset(2).Resize(13) = Application.Transpose(Sheets("INLUONGHD").[B4:N4])
    INHD.[F65536].End(3).Offset(2).Resize(13) = Application.Transpose(INLUONGHD.Range(("B" & i + 1), "N" & i + 1))
Next
End Sub

Còn đây là kiểu viết nâng cao, hình thức gọn đẹp và cho tốc độ nhanh như chớp. Thuật toán cũng giống na ná bài số 15
Muốn viết được kiểu này phải luyện ít nhất 01 tháng.

Sub INPHIEULUONG2()
Dim Sarr(), Darr(), i As Long, X As Long
With Sheets("INLUONGHD")
    Sarr = .Range(.[A4], .[A65536].End(3)).Offset(, 1).Resize(, 13).Value
End With
ReDim Darr(1 To 30000, 1 To 5)
For i = 2 To UBound(Sarr) Step 2
    For j = 1 To UBound(Sarr, 2)
        X = X + 1
        Darr(X, 1) = Sarr(1, j)
        Darr(X, 2) = Sarr(i, j)
        Darr(X, 4) = Sarr(1, j)
        Darr(X, 5) = Sarr(i + 1, j)
    Next
    X = X + 1
Next
Sheets("INHD").[B1].Resize(X, 5) = Darr
End Sub

 

[truckhoa2006]

Nếu không rành về code thì lấy code này mà vọc. Đơn giản và căn bản nhất.

Sub INPHIEULUONG1()
Dim i As Long, INHD As Worksheet, INLUONGHD As Worksheet
Set INHD = Sheets("INHD")
Set INLUONGHD = Sheets("INLUONGHD")
For i = 5 To INLUONGHD.[A65536].End(3).Row Step 2
    INHD.[B65536].End(3).Offset(2).Resize(13) = Application.Transpose(INLUONGHD.[B4:N4])
    INHD.[C65536].End(3).Offset(2).Resize(13) = Application.Transpose(INLUONGHD.Range(("B" & i), "N" & i))
    INHD.[E65536].End(3).Offset(2).Resize(13) = Application.Transpose(Sheets("INLUONGHD").[B4:N4])
    INHD.[F65536].End(3).Offset(2).Resize(13) = Application.Transpose(INLUONGHD.Range(("B" & i + 1), "N" & i + 1))
Next
End Sub

Còn đây là kiểu viết nâng cao, hình thức gọn đẹp và cho tốc độ nhanh như chớp. Thuật toán cũng giống na ná bài số 15
Muốn viết được kiểu này phải luyện ít nhất 01 tháng.

Sub INPHIEULUONG2()
Dim Sarr(), Darr(), i As Long, X As Long
With Sheets("INLUONGHD")
    Sarr = .Range(.[A4], .[A65536].End(3)).Offset(, 1).Resize(, 13).Value
End With
ReDim Darr(1 To 30000, 1 To 5)
For i = 2 To UBound(Sarr) Step 2
    For j = 1 To UBound(Sarr, 2)
        X = X + 1
        Darr(X, 1) = Sarr(1, j)
        Darr(X, 2) = Sarr(i, j)
        Darr(X, 4) = Sarr(1, j)
        Darr(X, 5) = Sarr(i + 1, j)
    Next
    X = X + 1
Next
Sheets("INHD").[B1].Resize(X, 5) = Darr
End Sub

Mầy mò áp dụng được rồi anh ah, chỉ là không hiểu chỗ nào hỏi chỗ đó thui đó mà. Và chỉ có chỗ này
Làm gần xong rùi, 4 sheet , nhập đoạn code anh cho và sửa lại cho dùng được , thì làm được có 3 sheet còn 1 sheet không biết bị sao mà nó cứ báo lỗi , ngay khúc này
Kq(k + j, 2) = Td(1, Cl(j))

Hoặc khúc này
Kq(k + j, 6) = Tm(i + 1, Cl(j))

Như em nói ở #17 thì em khắc phục được rồi, chỉ là em không hiểu 1 cái là có 1 dòng không biết nó bị làm sao mà nó cứ báo lỗi hoài, thế là em Insert thêm 1 dòng nữa và chuyễn dữ liệu xuống dòng đó rồi làm bình thường ah. Nên cuối cùng dòng đó không dám xóa chỉ biết Hide nó đi thui anh ah.