Nhờ sửa giúp code vba để lưu phiếu chi lương từ excel vào 1 file word

Liên hệ QC
C

chidung2009

Thành viên hoạt động
Tham gia
12/9/12
Bài viết
123
Được thích
8
Chào các anh chị!
mình có 1 sheet chưa thông tin chi lương cho nhân viên. Với đoạn code vba bên dưới khi chạy mỗi hàng nó tạo ra 1 file word với thông tin chi lương cho từng người, khi số lượng nv lên tới vài trăm thì việc lưu này nói rất bất tiện. Vậy em nhờ anh chị giúp em sửa đoạn code bên dưới sao cho lưu tất cả phiếu chi lương vào 1 file word duy nhất và mỗi phiếu sẽ nằm gọn trong 1 tờ giấy A4.
Mình xin cảm ơn

Mã: 
Option Explicit
Sub phieuchiluong()
    Dim num_of_cust As Long
    Dim num_of_column As Long
    Dim i As Long, j As Long
    Dim template As Object
    Dim t As Object

    num_of_column = 13
    num_of_cust = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row - 1
    With CreateObject("word.application")
        .Visible = True
        For i = 1 To num_of_cust
            Set template = .documents.Open(ThisWorkbook.Path & "\template\PhieuLuong.doc")
            Set t = template.Content
            For j = 1 To num_of_column
                t.Find.Execute _
                    FindText:=Sheet1.Cells(1, j).Value, _
                    ReplaceWith:=Sheet1.Cells(i + 1, j).Value, _
                    Replace:=wdReplaceAll
            Next
            template.SaveAs Filename:=ThisWorkbook.Path & Application.PathSeparator & i & "_phieuchiluong.doc"
        Next
        .Quit
    End With
    Set t = Nothing
    Set template = Nothing
End Sub
 
Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
"lưu phiếu chi lương từ excel vào 1 file word"

Sao lại làm ngược thế bạn. Bảng tính Excel là chuẩn chỉ để lưu trữ dữ liệu rồi. Các kỹ sư lập trình điên đầu mới nghĩ ra bảng tính để lưu dữ liệu, còn MS Word là để soạn thảo văn bản.
 
Upvote 0
chidung2009 đã viết:
Chào các anh chị!
mình có 1 sheet chưa thông tin chi lương cho nhân viên. Với đoạn code vba bên dưới khi chạy mỗi hàng nó tạo ra 1 file word với thông tin chi lương cho từng người, khi số lượng nv lên tới vài trăm thì việc lưu này nói rất bất tiện. Vậy em nhờ anh chị giúp em sửa đoạn code bên dưới sao cho lưu tất cả phiếu chi lương vào 1 file word duy nhất và mỗi phiếu sẽ nằm gọn trong 1 tờ giấy A4.
Mình xin cảm ơn

Mã: 
Option Explicit
Sub test()
Dim num_of_cust As Long, num_of_column As Long
Dim i As Long, j As Long, template As Object, t As Object

num_of_column = 6
num_of_cust = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row - 1
With CreateObject("word.application")
.Visible = True
For i = 1 To num_of_cust
Set template = .documents.Open(ThisWorkbook.Path & "\template\PhieuLuong.docx")
Set t = template.Content
For j = 1 To num_of_column
t.Find.Execute _
FindText:=Sheet1.Cells(1, j).Value, _
ReplaceWith:=Sheet1.Cells(i + 1, j).Value, _
Replace:=wdReplaceAll
Next j
Next i
template.SaveAs Filename:=ThisWorkbook.Path & Application.PathSeparator & i & "-phieuchiluong.docx"
.Quit
End With
Set t = Nothing
Set template = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
xin chào... mình xin file của bạn với ạ
 
Upvote 0
tuan16 đã viết:
xin chào... mình xin file của bạn với ạ
Nhấp chuột vào đây để mở rộng...
Mình gửi file chi lương của mình (Chỉ là bản Test)
Bài đã được tự động gộp:

befaint đã viết:
"lưu phiếu chi lương từ excel vào 1 file word"

Sao lại làm ngược thế bạn. Bảng tính Excel là chuẩn chỉ để lưu trữ dữ liệu rồi. Các kỹ sư lập trình điên đầu mới nghĩ ra bảng tính để lưu dữ liệu, còn MS Word là để soạn thảo văn bản.
Nhấp chuột vào đây để mở rộng...
Mình muốn làm phiếu chi lương từ bẳng excel cho nhân viên mà bạn
 

File đính kèm

  • phieu luong.zip
    25.1 KB · Đọc: 24
Upvote 0
buiquangthuan đã viết:
Sao bạn không tạo 1 phiếu mẫu bằng excell. sau đó sử dụng Vba đưa dữ liệu lần lượt vào. khi xong 1 người rồi thì tự động xuất thành pdf theo tên nhân viên hay gì gì đó.
Nhấp chuột vào đây để mở rộng...
dạ chào anh. ý bạn chủ thớt muốn khi xuất ra thì tất cả các nhân viên đều nằm trong cùng 1 file chứ không phải từng file riêng rẽ ạ
 
Upvote 0
chidung2009 đã viết:
Chào các anh chị!
mình có 1 sheet chưa thông tin chi lương cho nhân viên. Với đoạn code vba bên dưới khi chạy mỗi hàng nó tạo ra 1 file word với thông tin chi lương cho từng người, khi số lượng nv lên tới vài trăm thì việc lưu này nói rất bất tiện. Vậy em nhờ anh chị giúp em sửa đoạn code bên dưới sao cho lưu tất cả phiếu chi lương vào 1 file word duy nhất và mỗi phiếu sẽ nằm gọn trong 1 tờ giấy A4.
Mình xin cảm ơn
Nhấp chuột vào đây để mở rộng...
Code gì? Word có Mailings thì dùng nó thôi.
 
Upvote 0
chidung2009 đã viết:
Mailings có một số thứ bất tiện và ko linh hoạt trong nhiều trường hợp.
Nhấp chuột vào đây để mở rộng...
Tôi hơi khác người. Tôi thì lại nghĩ rằng "trong nhiều trường hợp" mà mỗi lần tôi đều phải lên đâu đó viết bài nhờ vả rồi chờ đợi có ai đó thương tình trả lời và giúp tôi, thì không thể gọi là linh hoạt được. Sự phụ thuộc không thể là điểm mạnh được.
 
Upvote 0
batman1 đã viết:
Tôi hơi khác người. Tôi thì lại nghĩ rằng "trong nhiều trường hợp" mà mỗi lần tôi đều phải lên đâu đó viết bài nhờ vả rồi chờ đợi có ai đó thương tình trả lời và giúp tôi, thì không thể gọi là linh hoạt được. Sự phụ thuộc không thể là điểm mạnh được.
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn đã góp ý. Thông thường trước khi lên diễn đàn hỏi mình đã thử viết code và tìm hiểu nhiều nhưng trình độ của mình còn hạn chế nên mong thông cảm
 
Upvote 0
chidung2009 đã viết:
Cảm ơn bạn đã góp ý. Thông thường trước khi lên diễn đàn hỏi mình đã thử viết code và tìm hiểu nhiều nhưng trình độ của mình còn hạn chế nên mong thông cảm
Nhấp chuột vào đây để mở rộng...
Thôi đươc ...
Những dòng code của bạn tôi giữ nguyên, chỉ thêm vài dòng mới.
Mã: 
Option Explicit

Sub phieuchiluong()
Const wdFormatOriginalFormatting = 16
Const wdPageBreak = 7
Const wdReplaceAll = 2

    Dim num_of_cust As Long
    Dim num_of_column As Long
    Dim i As Long, j As Long
    Dim template As Object
    Dim sel As Object, start As Long

    num_of_column = 13
    num_of_cust = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row - 1
    With CreateObject("word.application")
        .Visible = True
        Set template = .documents.Open(ThisWorkbook.Path & "\template\PhieuLuong.doc")
        Set sel = .Selection
        sel.WholeStory
        sel.Copy
        For i = 1 To num_of_cust
            For j = 1 To num_of_column
                sel.Find.Execute _
                    FindText:=Sheet1.Cells(1, j).Value, _
                    ReplaceWith:=Sheet1.Cells(i + 1, j).Value, _
                    Replace:=wdReplaceAll
            Next
            If i < num_of_cust Then
                With sel
                    .Collapse Direction:=0
                    .InsertBreak wdPageBreak
                End With
                start = sel.start
                sel.PasteAndFormat (wdFormatOriginalFormatting)
                sel.start = start
            End If
        Next
        template.SaveAs Filename:=ThisWorkbook.Path & Application.PathSeparator & i & "_phieuchiluong.doc"
        .Quit
    End With
    Set sel = Nothing
    Set template = Nothing
End Sub
 
Upvote 0
batman1 đã viết:
Thôi đươc ...
Những dòng code của bạn tôi giữ nguyên, chỉ thêm vài dòng mới.
Mã: 
Option Explicit

Sub phieuchiluong()
Const wdFormatOriginalFormatting = 16
Const wdPageBreak = 7
Const wdReplaceAll = 2

    Dim num_of_cust As Long
    Dim num_of_column As Long
    Dim i As Long, j As Long
    Dim template As Object
    Dim sel As Object, start As Long

    num_of_column = 13
    num_of_cust = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row - 1
    With CreateObject("word.application")
        .Visible = True
        Set template = .documents.Open(ThisWorkbook.Path & "\template\PhieuLuong.doc")
        Set sel = .Selection
        sel.WholeStory
        sel.Copy
        For i = 1 To num_of_cust
            For j = 1 To num_of_column
                sel.Find.Execute _
                    FindText:=Sheet1.Cells(1, j).Value, _
                    ReplaceWith:=Sheet1.Cells(i + 1, j).Value, _
                    Replace:=wdReplaceAll
            Next
            If i < num_of_cust Then
                With sel
                    .Collapse Direction:=0
                    .InsertBreak wdPageBreak
                End With
                start = sel.start
                sel.PasteAndFormat (wdFormatOriginalFormatting)
                sel.start = start
            End If
        Next
        template.SaveAs Filename:=ThisWorkbook.Path & Application.PathSeparator & i & "_phieuchiluong.doc"
        .Quit
    End With
    Set sel = Nothing
    Set template = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn rất nhiều
 
Upvote 0
batman1 đã viết:
Thôi đươc ...
Những dòng code của bạn tôi giữ nguyên, chỉ thêm vài dòng mới.
Mã: 
Option Explicit

Sub phieuchiluong()
Const wdFormatOriginalFormatting = 16
Const wdPageBreak = 7
Const wdReplaceAll = 2

    Dim num_of_cust As Long
    Dim num_of_column As Long
    Dim i As Long, j As Long
    Dim template As Object
    Dim sel As Object, start As Long

    num_of_column = 13
    num_of_cust = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row - 1
    With CreateObject("word.application")
        .Visible = True
        Set template = .documents.Open(ThisWorkbook.Path & "\template\PhieuLuong.doc")
        Set sel = .Selection
        sel.WholeStory
        sel.Copy
        For i = 1 To num_of_cust
            For j = 1 To num_of_column
                sel.Find.Execute _
                    FindText:=Sheet1.Cells(1, j).Value, _
                    ReplaceWith:=Sheet1.Cells(i + 1, j).Value, _
                    Replace:=wdReplaceAll
            Next
            If i < num_of_cust Then
                With sel
                    .Collapse Direction:=0
                    .InsertBreak wdPageBreak
                End With
                start = sel.start
                sel.PasteAndFormat (wdFormatOriginalFormatting)
                sel.start = start
            End If
        Next
        template.SaveAs Filename:=ThisWorkbook.Path & Application.PathSeparator & i & "_phieuchiluong.doc"
        .Quit
    End With
    Set sel = Nothing
    Set template = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...
Với đoạn code trên có sửa được đoạn nào để mình chỉ cần thay giá trị trong file word mẫu bằng các cột cụ thể trong excell không ạ. Ví dụ mình muốn lấy tại các ô d7, a3, e5 thì mình chèn trong word là d7,a3,e5 không ạ
 
Upvote 0
batman1 đã viết:
Tôi hơi khác người. Tôi thì lại nghĩ rằng "trong nhiều trường hợp" mà mỗi lần tôi đều phải lên đâu đó viết bài nhờ vả rồi chờ đợi có ai đó thương tình trả lời và giúp tôi, thì không thể gọi là linh hoạt được. Sự phụ thuộc không thể là điểm mạnh được.
Nhấp chuột vào đây để mở rộng...
Đối với bác nó là sự phụ thuộc.
Đối với người khác không hẳn vậy. Mục đích của người ta là thực hiện được cái ý tưởng hay cái sáng kiến gì đó. Cái ý tưởng/sáng kiến ấy cuối cùng cũng thực hiện mà không hề bị sửa đổi theo ai hết cho nên cũng khó gọi là bị phụ thuộc.
Bác nghĩ, nếu thớt lại lên "bác giúp cho em chỉnh chỗ này một chút", thì khả năng 99% là bác cũng lại làm tiếp. Như vậy sao gọi là phụ thuộc?
 
Lần chỉnh sửa cuối:
Upvote 0
VetMini đã viết:
Bác nghĩ, nếu thớt lại lên "bác giúp cho em chỉnh chỗ này một chút", thì khả năng 99% là bác cũng lại làm tiếp. Như vậy sao gọi là phụ thuộc?
Nhấp chuột vào đây để mở rộng...
Nhưng nếu đúng lúc tôi đi lang thang vài ngày thì chờ vêu mõm rồi. Lúc đó mới thấm thía, đấy là "sự" gì. :D
 
Upvote 0
tuan16 đã viết:
Với đoạn code trên có sửa được đoạn nào để mình chỉ cần thay giá trị trong file word mẫu bằng các cột cụ thể trong excell không ạ. Ví dụ mình muốn lấy tại các ô d7, a3, e5 thì mình chèn trong word là d7,a3,e5 không ạ
Nhấp chuột vào đây để mở rộng...
Đoạn code trên chạy vòng lặp For Next để kiểm tra và thay thế nên mình nghĩ là ko được. Còn muốn lấy tại các ô d7, a3, e5 phải viết lại.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

H
Kết nối vba với Database host (hiện tại đang làm host web)
Trả lời
2
Đọc
109
Haidang7979
H
emlat3
Đặt màu xen kẽ các dòng theo ký tự
Trả lời
1
Đọc
38
DeTong
D
D
Prime Сasual Dating - Verified Ladies
Trả lời
0
Đọc
20
djneunhu
D
S
  • Question
Không lấy đủ dữ liệu bằng kết nối ADO
2
Trả lời
20
Đọc
351
shnhatha221108
S
S
Slicer không chuyển qua trạng thái mờ.
Trả lời
1
Đọc
41
ptm0412
ptm0412
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom