Xuất hàng loạt từ Excel sang PDF trong 1 file (1 người xem)

Miccpro · 1/2/18

Em sưu tầm được trên mạng File xuất excel sang PDF. Sau khi xuất xong có thể dùng Web hoặc Phần mềm trung gian để gộp tất cả File PDF đó thành 1 File PDF duy nhất. Mong muốn của em là không dùng phần mềm trung gian mà xử lý bằng VBA để xuất ra 1 File duy nhất luôn ạ. Em xin cảm ơn

Miccpro · 1/2/18

Nếu VBA không xử lý được xuất 1 FIle duy nhất mong các bác giúp em: Tự động tạo 1 sheet 1, coppy đúng định dạng các trang sang sheet vừa tạo, xuất PDF và xóa Sheet vừa tạo được không ạ

Miccpro · 1/2/18

Miccpro đã viết:
Nếu VBA không xử lý được xuất 1 FIle duy nhất mong các bác giúp em: Tự động thêm mới 1 sheet, coppy đúng định dạng các trang sang sheet vừa tạo, xuất PDF và xóa Sheet vừa tạo được không ạ

Híc, Em sửa bài đăng mà ấn nhầm Reply, xin lỗi ạ

moctriet · 1/2/18

Đang bận code nên chỉ giúp bạn chút thông tin tham khảo.
https://trumpexcel.com/convert-excel-to-pdf/

Miccpro · 1/2/18

moctriet đã viết:
Đang bận code nên chỉ giúp bạn chút thông tin tham khảo.
https://trumpexcel.com/convert-excel-to-pdf/

Link die bác ạ. Nếu rảnh bác giúp em được nhé! cảm ơn bác

chisinhvnn · 1/2/18

link còn dùng được mà

Miccpro đã viết:
Link die bác ạ. Nếu rảnh bác giúp em được nhé! cảm ơn bác

Link còn dùng được mà bạn

Miccpro · 1/2/18

chisinhvnn đã viết:
link còn dùng được mà

Link còn dùng được mà bạn

Em tìm thấy code này:

Mã:

Sub PrintAllSheetsToPDF()
'SUBROUTINE: PrintAllSheetsToPDF
'DEVELOPER: Ryan Wells
'DESCRIPTION: Combine all your worksheets into one PDF
Dim strSheets() As String
Dim strfile As String
Dim sh As Worksheet
Dim icount As Integer
Dim myfile As Variant
'Save Chart Sheet names to an Array
For Each sh In ActiveWorkbook.Worksheets
If sh.Visible = xlSheetVisible Then
ReDim Preserve strSheets(icount)
strSheets(icount) = sh.Name
icount = icount + 1
End If
Next sh
If icount = 0 Then 'No charts found. Punch error
MsgBox "A PDF cannot be created because no sheets were found.", , "No Sheets Found"
Exit Sub
End If
'Prompt for save location
strfile = "Sheets" & "_" _
& Format(Now(), "yyyymmdd_hhmmss") _
& ".pdf"
strfile = ThisWorkbook.Path & "\" & strfile
myfile = Application.GetSaveAsFilename _
(InitialFileName:=strfile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and File Name to Save as PDF")
If myfile <> "False" Then 'save as PDF
ThisWorkbook.Sheets(strSheets).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
myfile, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
Else
MsgBox "No File Selected. PDF will not be saved", vbOKOnly, "No File Selected"
End If
End Sub

Nhưng không vận dụng được vào file đính kèm, bác giúp em được không, cảm ơn bác

Miccpro · 2/2/18

Có anh chị nào giúp được em không ạ. Hay là dùng phương án tạo file mới với nhiều sheets, sau khi xuất sang PDF thì xóa file hoặc coppy vào 1 sheet sau đó xuất dữ liệu từ sheet đó sang PDF. Mong các anh chị hướng dẫn, em xin cảm ơn

nmhung49 · 2/2/18

Miccpro đã viết:
Có anh chị nào giúp được em không ạ. Hay là dùng phương án tạo file mới với nhiều sheets, sau khi xuất sang PDF thì xóa file hoặc coppy vào 1 sheet sau đó xuất dữ liệu từ sheet đó sang PDF. Mong các anh chị hướng dẫn, em xin cảm ơn

Bạn dùng code đơn giản này chỉnh sửa lại theo yêu cầu

Mã:

Sub Macro1()    
    Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
    'Sheet1, sheet2, sheet3 la ten cac sheet muon in hang loat
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        ThisWorkbook.FullName, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False
End Sub

Miccpro · 2/2/18

nmhung49 đã viết:

Bạn dùng code đơn giản này chỉnh sửa lại theo yêu cầu

Mã:

Sub Macro1()   
    Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
    'Sheet1, sheet2, sheet3 la ten cac sheet muon in hang loat
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        ThisWorkbook.FullName, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False
End Sub

Em đang muốn cách xuất từ excel sang PDF chi trong 1 file PDF. Còn File đính kèm bài #1 đang xuất thành nhiều file PDF . Code của bác là sau khi đã đưa được ra các sheet thì Select All Sheet

huuthang_bd · 2/2/18

Mấy bác cứ trả lời mà chả chịu đọc yêu cầu của chủ thớt nên cứ trả lời đâu đâu -> khổ cho chủ thớt

.

Miccpro · 2/2/18

huuthang_bd đã viết:
Mấy bác cứ trả lời mà chả chịu đọc yêu cầu của chủ thớt nên cứ trả lời đâu đâu -> khổ cho chủ thớt .

cảm ơn anh rất rất nhiều ạ. Tuyệt vời luôn anh ạ
TIện thể cho em phiền xíu nữa, nếu lưu file mà trung tên, nếu không muốn xóa file cũ (không lưu đè) mà tạo thêm file mới thì có cách nào lưu giống mặc định excel là Name (1). pdf không anh

huuthang_bd · 2/2/18

Miccpro đã viết:
cảm ơn anh rất rất nhiều ạ. Tuyệt vời luôn anh ạ
TIện thể cho em phiền xíu nữa, nếu lưu file mà trung tên, nếu không muốn xóa file cũ (không lưu đè) mà tạo thêm file mới thì có cách nào lưu giống mặc định excel là Name (1). pdf không anh

Đã có cửa sổ đặt tên file thì cứ đặt tên trên đó chứ ai lại đặt tự động theo kiểu đó.
Tôi bổ sung cho bạn cảnh báo lưu trùng tên.

Miccpro · 2/2/18

huuthang_bd đã viết:
Đã có cửa sổ đặt tên file thì cứ đặt tên trên đó chứ ai lại đặt tự động theo kiểu đó.
Tôi bổ sung cho bạn cảnh báo lưu trùng tên.

Em đã test rất nhiều file của anh nhưng còn vướng 2 vấn đề để hoàn thiện. Đành phiền anh thêm vậy:
1. File excel đã Set Print_Area trong khổ giấy A4 nhưng xuất sang pdf lại là chế độ Letter nên bị tràn trang in. Em đã thử thêm

Mã:

 TmpSh.PageSetup.PaperSize = xlPaperA4

nhưng không được.
2. Các hàng ở File excel đang ẩn thì sang Pdf bị lộ hết và chiều rộng của hàng bị thay đổi

Mong anh giúp đỡ, em xin cảm ơn!

huuthang_bd · 2/2/18

Miccpro đã viết:
Em đã test rất nhiều file của anh nhưng còn vướng 2 vấn đề để hoàn thiện. Đành phiền anh thêm vậy:
1. File excel đã Set Print_Area trong khổ giấy A4 nhưng xuất sang pdf lại là chế độ Letter nên bị tràn trang in. Em đã thử thêm

Mã:

TmpSh.PageSetup.PaperSize = xlPaperA4

nhưng không được.
2. Các hàng ở File excel đang ẩn thì sang Pdf bị lộ hết và chiều rộng của hàng bị thay đổi
Mong anh giúp đỡ, em xin cảm ơn!

Nếu là vấn đề trên file ở bài #1 tôi sẽ hỗ trợ tiếp. Còn là file khác là do bạn đặt câu hỏi không sát với yêu cầu, đưa file giả lập không đúng với thực tế.
Có khi chỉ thay đổi yêu cầu một chút thôi phải viết lại toàn bộ code

. Đây là bài học đã được nói đi nói lại nhiều lần trên GPE.
Tạm biệt.

Miccpro · 2/2/18

huuthang_bd đã viết:
Nếu là vấn đề trên file ở bài #1 tôi sẽ hỗ trợ tiếp. Còn là file khác là do bạn đặt câu hỏi không sát với yêu cầu, đưa file giả lập không đúng với thực tế.
Có khi chỉ thay đổi yêu cầu một chút thôi phải viết lại toàn bộ code . Đây là bài học đã được nói đi nói lại nhiều lần trên GPE.
Tạm biệt.

Vâng, do em không lường hết khi trường hợp khi hỏi, thành thật xin lỗi. Em hiểu "Có khi chỉ thay đổi yêu cầu một chút thôi phải viết lại toàn bộ code" vì trong trường hợp trên rõ ràng phải thay đổi code (excel sẽ tự động Auot Fit Row Height khi paste). Em đã thử tạo file mới rồi move or copy sang (cái này giữ nguyên định dạng) nhưng không được do trong sheet chứa code VBA nên bị báo lỗi. Cảm ơn anh rất nhiều

thoai · 24/5/18

huuthang_bd đã viết:
Mấy bác cứ trả lời mà chả chịu đọc yêu cầu của chủ thớt nên cứ trả lời đâu đâu -> khổ cho chủ thớt .

Sao xuất bị lỗi dòng này Anh
Sub XuatPDF()
Dim maxR As Integer
Dim sFilename As String, Rs As Long, TmpSh As Worksheet
sFilename = Application.GetSaveAsFilename(Replace(ThisWorkbook.FullName, ".xlsm", ".pdf"), "PDF, *.pdf")
If sFilename = "False" Then Exit Sub
Application.ScreenUpdating = False
Set TmpSh = Sheets.Add
maxR = Sheet1.Range("F" & Rows.Count).End(xlUp).Value
Sheet1.[Print_Area].Copy
TmpSh.[A1].PasteSpecial xlPasteColumnWidths
For x = 1 To maxR
With Sheet1.Range("M2")
.Value = x
Call Spinner_getData
With Sheet1.[Print_Area]
.Copy TmpSh.Cells(Rs + 1, 1)
TmpSh.Cells(Rs + 1, 1).Resize(4, .Columns.Count).Value = .Resize(4).Value
Rs = Rs + .Rows.Count
TmpSh.HPageBreaks.Add TmpSh.Cells(Rs + 1, 1)
End With
End With
Next
TmpSh.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sFilename, Quality:=xlQualityStandard
Application.DisplayAlerts = False
TmpSh.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Well Done!"
End Sub

huuthang_bd · 24/5/18

Excel 2007 không hỗ trợ xuất PDF. Bạn tìm và cài đặt thêm phần mềm SaveAsPDFandXPS là được.

trongtuandkt · 13/10/18

huuthang_bd đã viết:
Mấy bác cứ trả lời mà chả chịu đọc yêu cầu của chủ thớt nên cứ trả lời đâu đâu -> khổ cho chủ thớt .

bác giúp e sửa code này với, hiện nó chạy ra nhiều file pdf e cũng muốn nó chỉ xuất ra 1 file pdf thôi

Private Function xuatpdf(ByVal FileName As String) As String
Dim n As Long
Dim sFolder As String, sFile As String, sExt As String, sTmpFile As String
sTmpFile = FileName
With CreateObject("Scripting.FileSystemObject")
sExt = .GetExtensionName(FileName)
sFolder = .GetParentFolderName(FileName)
sFile = .GetBaseName(FileName)
Do While .FileExists(sTmpFile) = True
n = n + 1
sTmpFile = .BuildPath(sFolder, sFile & "(" & n & ")." & sExt)
Loop
xuatpdf = sTmpFile
End With
End Function
Sub pdf()
Dim filepdf As String
Dim a1, a2, i, j&
a1 = Sheet2.Range("M19").Value
a2 = Sheet2.Range("M20").Value

B = Sheet2.Range("N16").Value
m = 1

Do
m = m + 1
If a1 <= a2 Then
For i = a1 To a2
Sheet2.Range("L16").Value = (i - 1) * 10 + 1
filepdf = xuatpdf(ThisWorkbook.Path & "\" & i & ".pdf")
Sheet2.ExportAsFixedFormat xlTypePDF, filepdf
filepdf = xuatpdf(ThisWorkbook.Path & "\" & i + 2 & ".pdf")
Sheet3.ExportAsFixedFormat xlTypePDF, filepdf
Next
End If
If m > B Then Exit Do
Loop

End Sub

be_09 · 13/10/18

Miccpro đã viết:
Em sưu tầm được trên mạng File xuất excel sang PDF. Sau khi xuất xong có thể dùng Web hoặc Phần mềm trung gian để gộp tất cả File PDF đó thành 1 File PDF duy nhất. Mong muốn của em là không dùng phần mềm trung gian mà xử lý bằng VBA để xuất ra 1 File duy nhất luôn ạ. Em xin cảm ơn

Góp ý cho bạn:
1/ Tìm bài viết với từ khóa In phiếu thu chi hàng loạt, code sẽ ngắn gọn hơn.
2/ Thay gì chọn máy in thì bạn chọn in PDF.

trongtuandkt · 13/10/18

be09 đã viết:
Góp ý cho bạn:
1/ Tìm bài viết với từ khóa In phiếu thu chi hàng loạt, code sẽ ngắn gọn hơn.
2/ Thay gì chọn máy in thì bạn chọn in PDF.

Minh đã in tự động với code đó được rồi.nhưng hiện tại nó xuất 1 trang in ra 1 file pdf. nếu nối thì bất tiện nên mục đích của mình muốn xuất tất cả ra 1 file pdf thôi nên nhờ các bạn chỉnh hộ code. Cảm ơn các bạn rất nhiều!

Private Function xuatpdf(ByVal FileName As String) As String
Dim n As Long
Dim sFolder As String, sFile As String, sExt As String, sTmpFile As String
sTmpFile = FileName
With CreateObject("Scripting.FileSystemObject")
sExt = .GetExtensionName(FileName)
sFolder = .GetParentFolderName(FileName)
sFile = .GetBaseName(FileName)
Do While .FileExists(sTmpFile) = True
n = n + 1
sTmpFile = .BuildPath(sFolder, sFile & "(" & n & ")." & sExt)
Loop
xuatpdf = sTmpFile
End With
End Function
Sub pdf()
Dim filepdf As String
Dim a1, a2, i, j&
a1 = Sheet2.Range("M19").Value
a2 = Sheet2.Range("M20").Value

If a1 < a2 Then

For i = a1 To a2
Sheet2.Range("L16").Value = (i - 1) * 10 + 1
filepdf = xuatpdf(ThisWorkbook.Path & "\" & i & ".pdf")
Sheet2.ExportAsFixedFormat xlTypePDF, filepdf

Next
End If
End Sub

Bài đã được tự động gộp: 13/10/18

huuthang_bd đã viết:
Excel 2007 không hỗ trợ xuất PDF. Bạn tìm và cài đặt thêm phần mềm SaveAsPDFandXPS là được.

Minh đã in tự động với code đó được rồi.nhưng hiện tại nó xuất 1 trang in ra 1 file pdf. nếu nối thì bất tiện nên mục đích của mình muốn xuất tất cả ra 1 file pdf thôi nên nhờ các bạn chỉnh hộ code. Cảm ơn các bạn rất nhiều!

Private Function xuatpdf(ByVal FileName As String) As String
Dim n As Long
Dim sFolder As String, sFile As String, sExt As String, sTmpFile As String
sTmpFile = FileName
With CreateObject("Scripting.FileSystemObject")
sExt = .GetExtensionName(FileName)
sFolder = .GetParentFolderName(FileName)
sFile = .GetBaseName(FileName)
Do While .FileExists(sTmpFile) = True
n = n + 1
sTmpFile = .BuildPath(sFolder, sFile & "(" & n & ")." & sExt)
Loop
xuatpdf = sTmpFile
End With
End Function
Sub pdf()
Dim filepdf As String
Dim a1, a2, i, j&
a1 = Sheet2.Range("M19").Value
a2 = Sheet2.Range("M20").Value

If a1 < a2 Then

For i = a1 To a2
Sheet2.Range("L16").Value = (i - 1) * 10 + 1
filepdf = xuatpdf(ThisWorkbook.Path & "\" & i & ".pdf")
Sheet2.ExportAsFixedFormat xlTypePDF, filepdf

Next
End If
End Sub

trongtuandkt · 19/10/18

hic có bạn nào giúp mình với

Doãn Quốc Bình · 15/10/20

nmhung49 đã viết:

Bạn dùng code đơn giản này chỉnh sửa lại theo yêu cầu

Mã:

Sub Macro1()   
    Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
    'Sheet1, sheet2, sheet3 la ten cac sheet muon in hang loat
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        ThisWorkbook.FullName, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False
End Sub

báo lỗi dòng này: Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select làm sao bây giờ các bác

hoamattroicoi · 15/10/20

Doãn Quốc Bình đã viết:
báo lỗi dòng này: Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select làm sao bây giờ các bác

Bạn kiểm tra tên sheet trong file của bạn có tên Sheet1, Sheet2, Sheet3 không hay là tên khác, nếu là tên khác thì thay tên tương ứng vào code này.

Doãn Quốc Bình · 15/10/20

hoamattroicoi đã viết:
Bạn kiểm tra tên sheet trong file của bạn có tên Sheet1, Sheet2, Sheet3 không hay là tên khác, nếu là tên khác thì thay tên tương ứng vào code này.
View attachment 247507

mình thay rồi mà vẫn báo lỗi đó bạn

quangduocx1 · 8/12/20

huuthang_bd đã viết:
Đã có cửa sổ đặt tên file thì cứ đặt tên trên đó chứ ai lại đặt tự động theo kiểu đó.
Tôi bổ sung cho bạn cảnh báo lưu trùng tên.

anh ơi cho e nhớ vs ạ. e, đang bị vướng là e đang làm lại file HSCLCTHANOI để xuất sheet 3 vs sheet 4 với chỉ số chạy ra pdf thành 1 file mà e chưa làm được ạ, e có xem mấy file vs mấy code của các anh chị mà e chưa làm được anh, hướng dẫn thêm cho e vs ạ, kiểu xuất pdf như file lylichcoc ạ
e cảm ơn anh ạ

Bài đã được tự động gộp: 8/12/20

quangduocx1 đã viết:
anh ơi cho e nhớ vs ạ. e, đang bị vướng là e đang làm lại file HSCLCTHANOI để xuất sheet 3 vs sheet 4 với chỉ số chạy ra pdf thành 1 file mà e chưa làm được ạ, e có xem mấy file vs mấy code của các anh chị mà e chưa làm được anh, hướng dẫn thêm cho e vs ạ, kiểu xuất pdf như file lylichcoc ạ
e cảm ơn anh ạ

Option Explicit

Sub InHangLoat()
Dim I As Integer, m As Integer
Dim TenCoc As String, lylichcoc As String
m = Range("DT.NK!B" & Cells.Rows.Count).End(xlUp).Row
For I = 13 To m
TenCoc = Range("DT.NK!B" & I).FormulaR1C1
With Sheets("2. NK")
.Range("R2").FormulaR1C1 = TenCoc
End With
lylichcoc = "lylichcoc" & I & ".pdf"

ThisWorkbook.Sheets(Array("2. NK", "3. Dia Chat", "4. PTDBT")).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"D:\" & lylichcoc, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
Next I
End Sub
code chạy file lylichcoc

chungpvc · 28/11/21

Chào các bác, các bác giúp em vấn đề này với ạ.
Em muốn xuất hàng loạt file excel ở sheet "PYCK95" ra file pdf rời rạc, dữ liệu ở sheet "PYCK95" được lấy từ sheet "ML" sang. File pdf sẽ lưu dưới định dạng "Cell C7".pdf
Bác nào biết chỉ giáo em với ạ. Em xin cảm ơn.

Xuất hàng loạt từ Excel sang PDF trong 1 file (1 người xem)

Người dùng đang xem chủ đề này

Thành viên thường trực

File đính kèm

Thành viên thường trực

Thành viên thường trực

Thành viên thường trực

Thành viên thường trực

Thành viên tiêu biểu

Thành viên thường trực

Thành viên thường trực

Thành viên tích cực

Thành viên thường trực

Chuyên gia GPE

File đính kèm

Thành viên thường trực

Chuyên gia GPE

File đính kèm

Thành viên thường trực

Chuyên gia GPE

Thành viên thường trực

Thành viên thường trực

File đính kèm

Chuyên gia GPE

Thành viên mới

Biên Hòa, Đồng Nai

Thành viên mới

File đính kèm

Thành viên mới

Thành viên chính thức

Thành viên gắn bó

Thành viên chính thức

Thành viên mới

File đính kèm

Thành viên mới

File đính kèm

Thời gian đếm ngược.