Code điều chỉnh kích thước và vùng khi xuất file ra pdf (1 người xem)

Liên hệ QC

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

trongtuandkt

Thành viên mới
Tham gia
10/10/18
Bài viết
6
Được thích
0
Chào các bạn mình sưu tầm trên diễn đàn (có chỉnh sửa lại) đoạn code dưới đây. Code đã chạy ra 1 file pdf như mong muốn nhưng mình gặp phải vấn đề nhờ các bạn giúp:
+ Các trang pdf lại chỉ lấy vùng in của sheet1 (A1:G42), mình muốn các sheet11, sheet12 lấy vùng in như đã chọn trên nó
+ Các hàng và cột giống như kích thước đã chọn ( vì nó đang giống với sheet1)

Sub XuatPDF()
Dim a1, a2, i&
b1 = Sheet1.Range("R4").Value
b2 = Sheet1.Range("R5").Value
Dim maxR As Integer
Dim sFilename As String, Rs As Long, TmpSh As Worksheet
GetFileName:
sFilename = Application.GetSaveAsFilename(Replace(ThisWorkbook.FullName, ".xlsm", ".pdf"), "PDF, *.pdf")
If sFilename = "False" Then Exit Sub
If sFilename Like "*\" & Dir(sFilename) Then
If Application.Assistant.DoAlert("C" & ChrW(7843) & "nh b" & ChrW(225) & "o", _
"File '" & sFilename & "' " & ChrW(273) & ChrW(227) & " t" & ChrW(7891) & "n t" & ChrW(7841) & "i, b" & ChrW(7841) & "n c" & ChrW(243) & " mu" & ChrW(7889) & "n l" & ChrW(432) & "u " & ChrW(273) & ChrW(232) & " kh" & ChrW(244) & "ng?", _
msoAlertButtonYesNo, msoAlertIconWarning, msoAlertDefaultFirst, msoAlertCancelDefault, False) <> 6 Then
sFilename = ""
GoTo GetFileName
End If
End If
Application.ScreenUpdating = False
Set TmpSh = Sheets.Add
maxR = Sheet1.Range("M" & Rows.Count).End(xlUp).Value
Sheet1.[Print_Area].Copy
TmpSh.[a1].PasteSpecial xlPasteColumnWidths
For i = b1 To b2
With Sheet1.Range("M2")
.Value = i
Call Spinner
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)
With Sheet11.[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)
With Sheet12.[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
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
 

File đính kèm

Web KT

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

Back
Top Bottom