Sửa Code Xuất ra 1 file PDF có nội dung trong nhiều Sheet
- Thread starter lenolim
- Ngày gửi
Theo dữ liệu trong File
Mã:
Sub GhiMacro()
Dim fR&, eR&
With Sheets("BanDau")
fR = .Range("F" & Rows.Count).End(xlUp).Row + 2
Sheets("TiepTheo").Range("G5:G25").Copy .Range("F" & fR)
.ResetAllPageBreaks
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=.Range("F" & fR)
eR = .Range("F" & Rows.Count).End(xlUp).Row
.PageSetup.PrintArea = "$F$2:$F$" & eR
.ExportAsFixedFormat 0, ThisWorkbook.Path & "\" & Range("A1")
.Range("F" & fR & ":F" & eR).Clear
End With
End Sub
Bài đã được tự động gộp:
Cảm ơn anh đã quan tâm.
Đúng là với Dữ liệu như trong file thì cách giải quyết này ổn rồi.
Tuy nhiên file cần áp dụng có Số dòng, số cột và các dữ liệu bên trong các Sheet là khác nhau
Vậy nên khi áp dụng vào file cần thiết thì nảy sinh vấn đề, do dữ liệu không đồng bộ như file đã gửi
Việc không lường trước vấn đề mang đến sự bất tiện này.
Em xin gửi lại file nhờ anh xem cách giải quyết.
(Em hỏi thêm là: Ta giải quyết bài toán trên theo vùng in đã chọn sẵn có được không)
Được, bạn tự làm thử vì in ấn phải có dữ liệu thực tế mới trình bày coi được
Về cơ bản. Hình thức và bố cục như file em gửi sau là được rồi anh. (Về cột, định dạng trang in ) có chăng là dữ liệu trong trong các trang in là thay đổi theo thực tế (có thể tăng hoặc giảm số hàng theo dữ liệu thực tế).
Mong nhận được sự trợ giúp từ anh.
Quan trọng là các cột và số ký tự, copy thử sẽ thấy
Số cột ở 2 Sheet đã cố định rồi.
Như anh đang làm: Tức là ta Coppy dữ liệu ở Sheet TiepTheo sang Sheet BanDau.
Lúc đó, do số cột của 2 Sheet là không như nhau
Nên dữ liệu Sheet TiepTheo Coppy sang Sheet BanDau
Sẽ không giống như việc đã được căn chỉnh như Sheet TiepTheo hiện tại
Vậy nên em với đang nghĩ cách là Xuất ra PDF Sheet BanDau xong rồi xuất tiếp Sheet TiepTheo
(Không biết kiểu này có thực hiện được không). Thế nên bài #1 em mới hỏi theo hướng này.
Trao đổi cùng anh như vậy, để tìm cách giải quyết.
Trân trọng !
Mình không biết được không vì không rành lệnh gán vào file pdf
Cách khác là trong sheet bandau, bạn Merge các cell vùng dữ liệu copy từ sheet tieptheo sao cho vừa đủ các cột và không bị thiếu dữ liệu gốc, dựa vào trình bày mẩu nầy mình sẽ viết code
Đây là file em định dạng và coppy thử mẫu dữ liệu.
Anh xem cách giải quyết.
Trân trọng !
Sheet bandau dòng 54-57 có dữ liệu gì không? tại sao khác số dòng sheet tieptheo
Bài đã được tự động gộp:
Sheet tieptheo: Có copy dòng 5-8 và 2003-2014 không? nếu có, các ô đang trống có dữ liệu gì
Lần chỉnh sửa cuối:
Xin lỗi anh vì bây giờ em mới trả lời được.
1. Mục đích của file là lấy dữ liệu thay đổi bên Sheet TiepTheo (từ dòng 11 - 2002 (Có cả dòng trống))
2. Sheet BanDau dòng 54-47 khác dòng bên Sheet TiepTheo. Em không để ý (Vì nghĩ nó là dữ liệu cố định)
3. Sheet TiepTheo Dòng 5-8 và dòng 2003-2014. Nó chỉ là tiêu đề cố định. Cái này mình có thể đặt trước. Không cần Coppy.
Thông tin lại đến anh.
Dùng tạm code
Mã:
Sub GhiMacro()
Dim sArr(), Res(), jArr, sR&, eR&
With Sheets("TiepTheo")
sR = Application.CountA(.Range("C11:C2002"))
If sR = 0 Then sR = 1
sArr = .Range("C11:H11").Resize(sR).Value
End With
ReDim Res(1 To sR, 1 To 16)
jArr = Array(0, 1, 2, 8, 10, 13, 16)
For i = 1 To sR
For j = 1 To UBound(sArr, 2)
Res(i, jArr(j)) = sArr(i, j)
Next j
Next i
Application.ScreenUpdating = False
With Sheets("BanDau")
.Range("B53:B509").EntireRow.Hidden = False
.Range("B60:Q60").Resize(sR) = Res
.Range("B" & 60 + sR + 1 & ":B498").EntireRow.Hidden = True
.PageSetup.PrintArea = "BanDau!$B$2:$R$26,BanDau!$B$28:$R$51,BanDau!$B$53:$R$508"
.ExportAsFixedFormat 0, ThisWorkbook.Path & "\" & Range("A1")
.Range("B53:B509").EntireRow.Hidden = True
End With
Application.ScreenUpdating = True
End SubCảm ơn anh.! Code chạy ổn.
Có vấn đề phát sinh là: Sheet BanDau dòng 60 - 498. Phần dữ liệu Coppy xong cần căn chỉnh dòng tự động (Vì các dòng đang bị hòa ô nên excel không tự động giãn dòng được)
Vấn đề giãn dòng này có tự động được không hay phải làm thủ công.
Thông tin đến anh.
Mã:
Sub GhiMacro()
Dim sArr(), Res(), jArr, sR&, eR&
With Sheets("TiepTheo")
sR = Application.CountA(.Range("C11:C2002"))
If sR = 0 Then sR = 1
sArr = .Range("C11:H11").Resize(sR).Value
End With
ReDim Res(1 To sR, 1 To 16)
jArr = Array(0, 1, 2, 8, 10, 13, 16)
For i = 1 To sR
For j = 1 To UBound(sArr, 2)
Res(i, jArr(j)) = sArr(i, j)
Next j
Next i
Application.ScreenUpdating = False
Call Cot
With Sheets("BanDau")
.Range("B53:B509").EntireRow.Hidden = False
.Range("B60:Q60").Resize(sR) = Res
.Range("T60:Y60").Resize(sR) = sArr
Range("T60:Y60").WrapText = True
.Range("B60:Q60").Resize(sR).EntireRow.AutoFit
.Range("B" & 60 + sR + 1 & ":B498").EntireRow.Hidden = True
.PageSetup.PrintArea = "BanDau!$B$2:$R$26,BanDau!$B$28:$R$51,BanDau!$B$53:$R$508"
.ExportAsFixedFormat 0, ThisWorkbook.Path & "\" & Range("A1")
.Range("B53:B509").EntireRow.Hidden = True
End With
Application.ScreenUpdating = True
End Sub
Private Sub Cot()
Dim jArr, d, i, j, cW
d = 0.64
jArr = Array(0, 1, 2, 8, 10, 13, 16, 19)
For j = 1 To 6
cW = 0
For n = jArr(j) + 1 To jArr(j + 1)
cW = cW + d + Cells(1, n).ColumnWidth
Next n
Cells(1, 19 + j).ColumnWidth = cW - d
Next j
End SubChỉnh lại Sub
Mã:
Sub XuatSheetsPDF()
Dim eR&
With Sheets("BanDau")
.PageSetup.PrintArea = "BanDau!$B$2:$R$26,BanDau!$B$28:$R$51"
End With
With Sheets("TiepTheo")
.PageSetup.PrintArea = "TiepTheo!$C$5:$H$2014"
eR = .Range("C2002").End(xlUp).Row
If eR > 10 Then Range("C" & eR + 1 & ":C2001").EntireRow.Hidden = True
End With
Sheets(Array("BanDau", "TiepTheo")).Select
ActiveSheet.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & Sheets("BanDau").Range("A1")
End SubSub này hay quá.
Khỏi cần coppy, paste cho nó loàng ngoằng.
Cảm ơn anh nhiều ...... ! ./.
