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
+ 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