e cảm ơn. Mai có máy tính e làm thử ạ.
Sao không viết luôn trong Word cho gọn nhỉ, cái này chẳng liên quan gì đến Excel cả.
em in được rồi ạ. em cảm ơn.
module này thì máy mình chạy mượt luôn
Em in vẫn chưa khắc phục được. Ko biết có phải là do máy tính của em bị thế ko ạ
(
Word mình không rành nên tiện tay viết trên Excel.
Bạn thay toàn bộ code cũ ở Module 1 bằng code sau thử nhé:
Sub InNhieuFilesWord()
Dim FolderPath As String
Dim fso As Object
Dim folder As Object
Dim file As Object
Dim wordApp As Object
Dim wordDoc As Object
Dim printCopies As Integer
Dim fileCount As Integer
' Tat cap nhat man hinh va canh bao
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
' Duong dan den thu muc chua cac file Word
FolderPath = Sheet1.Range("B1").Value & "\"
' So ban in cho moi file
printCopies = Sheet1.Range("B2").Value
' Khoi tao FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(FolderPath)
' Khoi tao ung dung Word
Set wordApp = CreateObject("Word.Application")
wordApp.Visible = False ' An Word de tang toc do
' Dem so file da in
fileCount = 0
' Lap qua cac file trong thu muc
For Each file In folder.Files
If LCase(fso.GetExtensionName(file.Name)) = "docx" Or _
LCase(fso.GetExtensionName(file.Name)) = "docm" Or _
LCase(fso.GetExtensionName(file.Name)) = "doc" Then
' Mo file Word
Set wordDoc = wordApp.Documents.Open(file.Path, ReadOnly:=True)
' In file voi so ban in da chi dinh
wordDoc.PrintOut Copies:=printCopies
' Dong file Word ma khong luu thay doi
wordDoc.Close SaveChanges:=False
' Tang so file da in
fileCount = fileCount + 1
End If
Next file
' Dong ung dung Word
wordApp.Quit
' Giai phong bo nho
Set wordDoc = Nothing
Set wordApp = Nothing
Set folder = Nothing
Set fso = Nothing
' Kich hoat lai cap nhat man hinh va canh bao
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
' Hien thi thong bao hoan thanh
MsgBox "Da in xong " & fileCount & " file Word, moi file " & printCopies & " ban.", vbInformation
End Subem in được mượt mà rồi ạ. tiền bối giỏi mà tận tâm quá. em cảm ơn rất rất nhiều ạ.
Khả năng có thể do đường dẫn mà bạn điền ở ô B1 không tồn tại.
Set folder = fso.GetFolder(FolderPath) ' Khoi tao FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
' Kiem tra xem thu muc co ton tai khong
If fso.FolderExists(FolderPath) Then
Set folder = fso.GetFolder(FolderPath)
Else
MsgBox "Thu muc khong ton tai. Vui long kiem tra lai duong dan.", vbExclamation
Exit Sub
End If
