Bạn phải có file mẫu có dữ liệu xem chuyển sang định dạng pdf vùng nào đến vùng nào, kết quả mong muốn trông nó ra sao, chứ đưa file trắng thế này thì ai đó muốn giúp cũng chịu.
Dạ trong file em đang có code như thế này ạ. Hiện tại chạy ổn, nhưng em muốn thêm 1 vài tính năng như bên dưới ạ.
1. PDF cả file word,excel và autocad.
2. Trong file excel em có nhiều sheet tuy nhiên em chỉ muốn pdf sheetA thôi ạ.
3. Sau khi pdf em muốn tự động mở các file đã pdf ạ.
Sub BatchOpenMultiplePSTFiles()
Dim objShell As Object
Dim objWindowsFolder As Object
Dim strWindowsFolder As String
'Select the specific Windows folder
Set objShell = CreateObject("Shell.Application")
Set objWindowsFolder = objShell.BrowseForFolder(0, "Select a Windows folder:", 0, "")
If Not objWindowsFolder Is Nothing Then
strWindowsFolder = objWindowsFolder.self.Path & "\"
Call ProcessFolders(strWindowsFolder)
'Open the windows folder
Shell "Explorer.exe" & " " & strWindowsFolder, vbNormalFocus
End If
End Sub
Sub ProcessFolders(strPath As String)
Application.ScreenUpdating = False
Dim objFileSystem As Object
Dim objFolder As Object
Dim objFile As Object
Dim objExcelFile As Object
Dim objWorkbook As Excel.Workbook
Dim strWorkbookName As String
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFileSystem.GetFolder(strPath)
For Each objFile In objFolder.Files
strFileExtension = objFileSystem.GetExtensionName(objFile)
If LCase(strFileExtension) = "xls" Or LCase(strFileExtension) = "xlsx" Then
Set objExcelFile = objFile
Set objWorkbook = Application.Workbooks.Open(objExcelFile.Path)
strWorkbookName = Left(objWorkbook.Name, (Len(objWorkbook.Name) - Len(strFileExtension)) - 1)
objWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strPath & strWorkbookName & ".pdf"
objWorkbook.Close False
End If
Next
'Process all folders and subfolders
If objFolder.SubFolders.Count > 0 Then
For Each objSubFolder In objFolder.SubFolders
If ((objSubFolder.Attributes And 2) = 0) And ((objSubFolder.Attributes And 4) = 0) Then
ProcessFolders (objSubFolder.Path)
End If
Next
End If
Application.ScreenUpdating = True
End Sub
