Chỉnh sửa file Print... (1 người xem)

[tanthanhkg]

Em có 1 đoạn code của file Print do anh trên diễn đàn này gửi cho em, file này hoạt động tốt, em nhờ mọi người chỉnh sửa dùm em một chút xíu ạ :
Mở file Print lên nhắp chuột vào nút click rồi chọn thư mục (HOCSINH) chứa các file cần in thì nó sẽ in tất cả từ a->z.
Vậy em muốn nhắp chuột vào nút click của file Print rồi chọn thư mục chứa các file cần in, sau đó em muốn xuất hiện thông báo tiếp theo "chọn sheet cần in", sau khi đã chọn sheet cần in sẽ hiện ra thông báo "In trang lẻ hoặc trang chẵn hoặc in tất cả" rồi bấm vào lệnh in để in ra theo ý muốn. Hoặc có đoạn code nào xin chia sẻ cho em.
Xin quí thầy (cô) cùng các anh chị giúp đỡ.
Xin cảm ơn.
==================
Sub Main()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Const extFile As String = "xls"
Dim pFolder As String, wb As Workbook, wsName As String, wbName As String
Dim arName, i As Long, aTem, pFile As String
pFolder = GetpFolder("")
If Len(pFolder) = 0 Then Exit Sub
pFolder = pFolder & "\"
arName = GetFilesInFolder(pFolder, extFile)
If typeName(arName) <> "Variant()" Then Exit Sub
wbName = VBA.UCase(ThisWorkbook.Name)
For Each aTem In arName
If Not VBA.UCase(aTem) Like wbName Then
pFile = pFolder & aTem
Set wb = Workbooks.Open(pFile)
wsName = NameSheet2Print(wb)
If Len(wsName) > 0 Then
wb.Worksheets(wsName).PrintOut 'In ngay
End If
wb.Close False
End If
Next aTem
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Function NameSheet2Print(ByVal wb As Workbook) As String
Dim ws As Worksheet
For Each ws In wb.Worksheets
If ws.Name Like "#*" Then
NameSheet2Print = ws.Name
Exit For
End If
Next ws
End Function

Public Function GetpFolder(ByVal pFolder As String) As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = pFolder
If .Show Then GetpFolder = .SelectedItems(1)
End With
End Function

Public Function GetFilesInFolder(ByVal pFolder As String, ByVal extensionFile As String)
Dim FSo As Object, objFolder As Object, objFile As Object, Result(), i As Long
Set FSo = CreateObject("Scripting.FileSystemObject")
Set objFolder = FSo.GetFolder(pFolder)
extensionFile = VBA.UCase(extensionFile)
For Each objFile In objFolder.Files
If VBA.UCase(FSo.GetExtensionName(objFile)) Like extensionFile Then
i = i + 1
ReDim Preserve Result(1 To i)
Result(i) = objFile.Name
End If
Next objFile
If i > 0 Then GetFilesInFolder = Result
End Function