Xin Code Insert Header/ Footer tự động cho excel (1 người xem)

[hanphilong103]

Chào các anh/chị,


Hiện, em đang cần insert header/ footer cho file excel ( số lượng nhiều), nên nhờ anh/chị tư vấn

& em sử dụng Record Macro ghi lại thao tác nhưng nó chỉ thực hiện trên một sheet

Nhờ anh/chị nào hỗ trợ cho nó ứng dụng trên tất cả các sheet trong một file.

Cảm ơn sự hỗ trợ của mọi người.

 

[phanminhphuong]

Chào các anh/chị,


Hiện, em đang cần insert header/ footer cho file excel ( số lượng nhiều)

Vậy thì bạn dùng vòng lặp chạy qua các Sheet rồi PageSetup cho từng Sheet là được mà. Bạn record macro thì cũng nên chỉnh sửa cho ngắn gọn dễ hiểu, VD giá trị = "", false sao ko thử bỏ khỏi code xem thế nào, có chạy như mong muốn không? Hơn nữa bạn record thao tác PageSetup 2 lần để làm gì ?
[GPECODE=vb]Private Sub CommandButton1_Click()
Dim wSheet As Worksheet
Application.ScreenUpdating = False
For Each wSheet In ThisWorkbook.Worksheets
With wSheet.PageSetup
'.LeftHeader = ""
'.CenterHeader = ""
'.RightHeader = ""
.LeftFooter = "Appendix/P14/Specification"
'.CenterFooter = ""
.RightFooter = "Page &P/&N"
.LeftMargin = Application.InchesToPoints(0.7)
.RightMargin = Application.InchesToPoints(0.7)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
'.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
'.OddAndEvenPagesHeaderFooter = False
'.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
'.EvenPage.LeftHeader.Text = ""
'.EvenPage.CenterHeader.Text = ""
'.EvenPage.RightHeader.Text = ""
'.EvenPage.LeftFooter.Text = ""
'.EvenPage.CenterFooter.Text = ""
'.EvenPage.RightFooter.Text = ""
'.FirstPage.LeftHeader.Text = ""
'.FirstPage.CenterHeader.Text = ""
'.FirstPage.RightHeader.Text = ""
'.FirstPage.LeftFooter.Text = ""
'.FirstPage.CenterFooter.Text = ""
'.FirstPage.RightFooter.Text = ""
End With
Next
Application.ScreenUpdating = True
End Sub[/GPECODE]

 

[phucbugis]

Chào các anh/chị,


Hiện, em đang cần insert header/ footer cho file excel ( số lượng nhiều), nên nhờ anh/chị tư vấn

& em sử dụng Record Macro ghi lại thao tác nhưng nó chỉ thực hiện trên một sheet

Nhờ anh/chị nào hỗ trợ cho nó ứng dụng trên tất cả các sheet trong một file.

Cảm ơn sự hỗ trợ của mọi người.

Sao ko search ngay trong GPE nhỉ?
link Header&Footer

mình dựa vào đó và làm giúp bạn file này đây.
Link MediaFire: Insert Header-Footer Excel (1)

Chào !

 

[phanminhphuong]

Ngoài ra bạn còn có thể tham khảo Code PageSetup của John Green (dùng XL4)

VD1:
[GPECODE=vb]Sub PS()
ActiveSheet.DisplayPageBreaks = False
With ActiveSheet.PageSetup
.LeftHeader = "My Company"
.CenterHeader = ""
.RightHeader = "&D / &T"
.LeftFooter = "Highly Confidential and Proprietary"
.CenterFooter = ""
.RightFooter = "Finance"
.LeftMargin = Application.InchesToPoints(0.54)
.RightMargin = Application.InchesToPoints(0.3)
.TopMargin = Application.InchesToPoints(0.4)
.BottomMargin = Application.InchesToPoints(0.36)
.HeaderMargin = Application.InchesToPoints(0.22)
.FooterMargin = Application.InchesToPoints(0.17)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
' .PrintQuality = 600 ' does not work with all the printers
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
End Sub
'------------------------------------------------------------
Sub PS4()
head = """&LMy Company&R&D / &T"""
foot = """&LHighly Confidential and Proprietary&RFinance"""
pLeft = 0.54
pRight = 0.3
Top = 0.4
bot = 0.36
head_margin = 0.22
foot_margin = 0.17
hdng = False
grid = False
notes = False
quality = ""
h_cntr = False
v_cntr = False
orient = 2
Draft = False
paper_size = 1
pg_num = """Auto"""
pg_order = 1
bw_cells = False
pscale = True
pSetUp = "PAGE.SETUP(" & head & "," & foot & "," & pLeft & "," & pRight & ","
pSetUp = pSetUp & Top & "," & bot & "," & hdng & "," & grid & "," & h_cntr & ","
pSetUp = pSetUp & v_cntr & "," & orient & "," & paper_size & "," & pscale & ","
pSetUp = pSetUp & pg_num & "," & pg_order & "," & bw_cells & "," & quality & ","
pSetUp = pSetUp & head_margin & "," & foot_margin & "," & notes & "," & Draft & ")"

Application.ExecuteExcel4Macro pSetUp
End Sub[/GPECODE]

VD2:
[GPECODE=vb]Sub test1()
With ActiveSheet.PageSetup
.CenterHorizontally = True
.PaperSize = xlPaperLetter
End With
End Sub
'---------------------------------------------------
Sub PS4_1()
h_cntr = True
paper_size = 1
pSetUp = "PAGE.SETUP(" & head & "," & foot & "," & pLeft & "," & pRight & ","
pSetUp = pSetUp & Top & "," & bot & "," & hdng & "," & grid & "," & h_cntr & ","
pSetUp = pSetUp & v_cntr & "," & orient & "," & paper_size & "," & pscale & ","
pSetUp = pSetUp & pg_num & "," & pg_order & "," & bw_cells & "," & quality & ","
pSetUp = pSetUp & head_margin & "," & foot_margin & "," & notes & "," & Draft & ")"

Application.ExecuteExcel4Macro pSetUp
End Sub[/GPECODE]

VD3:
[GPECODE=vb]Sub test2()
With ActiveSheet.PageSetup
.TopMargin = Application.InchesToPoints(0.78740157480315)
.BottomMargin = Application.InchesToPoints(0.78740157480315)
.CenterHorizontally = True
.Orientation = xlLandscape
End With
End Sub
'---------------------------------------------------------
Sub PS4_2()
Top = 0.79
bot = 0.79
h_cntr = True
orient = 2
pSetUp = "PAGE.SETUP(" & head & "," & foot & "," & pLeft & "," & pRight & ","
pSetUp = pSetUp & Top & "," & bot & "," & hdng & "," & grid & "," & h_cntr & ","
pSetUp = pSetUp & v_cntr & "," & orient & "," & paper_size & "," & pscale & ","
pSetUp = pSetUp & pg_num & "," & pg_order & "," & bw_cells & "," & quality & ","
pSetUp = pSetUp & head_margin & "," & foot_margin & "," & notes & "," & Draft & ")"

Application.ExecuteExcel4Macro pSetUp
End Sub[/GPECODE]