【VBA視頻合集】Word VBA教程 Excel VBA教程 WordVBA教
'以下代碼看得懂的都看得懂，看不懂的還是看不懂，僅供參考。正常情況下在機器上是跑不了的，因為引用到了具體數據，是批量設置銀行存款日記賬Excel頁面排版并轉為PDF文件的示例。
'原文有點泄露敏感信息，本來想隨手刪了，發(fā)現作者看過，有點難為情，又發(fā)了上來。
Sub DepositJournal_USD_x_PDF()
? Dim n$, cc$, hc$, at$, h$, PDFName$, P$
? Dim r&, c&
? '初始化變量
? n = ActiveSheet.Name
? P = Split(n, "_")(1)
? cc = Application.WorksheetFunction.XLookup(n, _
? Sheets("Idx-x").Range("A:A"), _
? Sheets("Idx-x").Range("B:B"), , , -1)'工作簿內表間搜索某神秘變量cc
? hc = Application.WorksheetFunction.XLookup(n, _
? Sheets("Idx-x").Range("A:A"), _
? Sheets("Idx-x").Range("C:C"), , , -1)'工作簿內表間搜索某神秘變量hc
? r = ActiveSheet.UsedRange.Rows.Count '已使用行數
? c = ActiveSheet.UsedRange.Columns.Count '已使用列數
? PDFName = ThisWorkbook.Path & "\..\PDF\日記賬\" & hc & ".pdf"
? '插入兩行
? Rows("1:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
? '初始化表單單元格顏色、字體顏色、邊框樣式
? Cells.Select
? With Selection.Interior
? ? .Pattern = xlNone
? ? .TintAndShade = 0
? ? .PatternTintAndShade = 0
? End With
? With Selection.Font
? ? .ColorIndex = xlAutomatic
? ? .TintAndShade = 0
? End With
? Selection.Borders(xlDiagonalDown).LineStyle = xlNone
? Selection.Borders(xlDiagonalUp).LineStyle = xlNone
? Selection.Borders(xlEdgeLeft).LineStyle = xlNone
? Selection.Borders(xlEdgeTop).LineStyle = xlNone
? Selection.Borders(xlEdgeBottom).LineStyle = xlNone
? Selection.Borders(xlEdgeRight).LineStyle = xlNone
? Selection.Borders(xlInsideVertical).LineStyle = xlNone
? Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
?'設置首行次行，其余行行高
? Selection.RowHeight = 25
? Selection.Font.Name = "宋體"
? Selection.Font.Size = 10
? Rows("1:1").Select
? Selection.RowHeight = 42
? Selection.Font.Name = "宋體"
? Selection.Font.Size = 16
? Selection.Font.Bold = True
? Rows("2:2").Select
? Selection.RowHeight = 5
'縱向居中
? Cells.Select
? With Selection
? ? .VerticalAlignment = xlCenter
? ? .WrapText = False
? ? .Orientation = 0
? ? .AddIndent = False
? ? .IndentLevel = 0
? ? .ShrinkToFit = False
? ? .ReadingOrder = xlContext
? End With
'E列居中
? Columns("B:B").Select
? With Selection
? ? .HorizontalAlignment = xlLeft
? ? .VerticalAlignment = xlCenter
? ? .WrapText = True
? ? .Orientation = 0
? ? .AddIndent = False
? ? .IndentLevel = 0
? ? .ShrinkToFit = False
? ? .ReadingOrder = xlContext
? ? .MergeCells = False
? End With
'標題行橫向居中
? Rows("3:4").Select
? With Selection
? ? .HorizontalAlignment = xlCenter
? ? .VerticalAlignment = xlCenter
? ? .WrapText = False
? ? .Orientation = 0
? ? .AddIndent = False
? ? .IndentLevel = 0
? ? .ShrinkToFit = False
? ? .ReadingOrder = xlContext
? ? .MergeCells = False
? End With
? '方向列橫向居中
? Columns("H:H").Select
? With Selection
? ? .HorizontalAlignment = xlCenter
? ? .VerticalAlignment = xlCenter
? ? .WrapText = False
? ? .Orientation = 0
? ? .AddIndent = False
? ? .IndentLevel = 0
? ? .ShrinkToFit = False
? ? .ReadingOrder = xlContext
? End With
? 'A1寫入“科目"
? Range("A1").Select
? ActiveCell.FormulaR1C1 = "科目"
? With Selection
? ? .HorizontalAlignment = xlCenter
? ? .VerticalAlignment = xlCenter
? ? .WrapText = False
? ? .Orientation = 0
? ? .AddIndent = False
? ? .IndentLevel = 0
? ? .ShrinkToFit = False
? ? .ReadingOrder = xlContext
? ? .MergeCells = False
? End With
? 'B1寫入科目內容，合并B1:K1
? Range("B1").Select
? ActiveCell.FormulaR1C1 = cc
? Range("B1:K1").Select
? Selection.Merge
? With Selection
? ? .HorizontalAlignment = xlLeft
? ? .VerticalAlignment = xlCenter
? ? .WrapText = False
? ? .Orientation = 0
? ? .AddIndent = False
? ? .IndentLevel = 0
? ? .ShrinkToFit = False
? ? .ReadingOrder = xlContext
? ? .MergeCells = True
? End With
? Range("D3:E3").Select
? Selection.Merge
? With Selection
? ? .HorizontalAlignment = xlCenter
? ? .VerticalAlignment = xlCenter
? ? .WrapText = False
? ? .Orientation = 0
? ? .AddIndent = False
? ? .IndentLevel = 0
? ? .ShrinkToFit = False
? ? .ReadingOrder = xlContext
? ? .MergeCells = True
? End With
? Range("F3:G3").Select
? Selection.Merge
? With Selection
? ? .HorizontalAlignment = xlCenter
? ? .VerticalAlignment = xlCenter
? ? .WrapText = False
? ? .Orientation = 0
? ? .AddIndent = False
? ? .IndentLevel = 0
? ? .ShrinkToFit = False
? ? .ReadingOrder = xlContext
? ? .MergeCells = True
? End With
? Range("I3:J3").Select
? Selection.Merge
? With Selection
? ? .HorizontalAlignment = xlCenter
? ? .VerticalAlignment = xlCenter
? ? .WrapText = False
? ? .Orientation = 0
? ? .AddIndent = False
? ? .IndentLevel = 0
? ? .ShrinkToFit = False
? ? .ReadingOrder = xlContext
? ? .MergeCells = True
? End With
? Range("A3:A4").Select
? Selection.Merge
? With Selection
? ? .HorizontalAlignment = xlCenter
? ? .VerticalAlignment = xlCenter
? ? .WrapText = False
? ? .Orientation = 0
? ? .AddIndent = False
? ? .IndentLevel = 0
? ? .ShrinkToFit = False
? ? .ReadingOrder = xlContext
? ? .MergeCells = True
? End With
? Range("B3:B4").Select
? Selection.Merge
? With Selection
? ? .HorizontalAlignment = xlCenter
? ? .VerticalAlignment = xlCenter
? ? .WrapText = False
? ? .Orientation = 0
? ? .AddIndent = False
? ? .IndentLevel = 0
? ? .ShrinkToFit = False
? ? .ReadingOrder = xlContext
? ? .MergeCells = True
? End With
? Range("C3:C4").Select
? Selection.Merge
? With Selection
? ? .HorizontalAlignment = xlCenter
? ? .VerticalAlignment = xlCenter
? ? .WrapText = False
? ? .Orientation = 0
? ? .AddIndent = False
? ? .IndentLevel = 0
? ? .ShrinkToFit = False
? ? .ReadingOrder = xlContext
? ? .MergeCells = True
? End With
? Range("H3:H4").Select
? Selection.Merge
? With Selection
? ? .HorizontalAlignment = xlCenter
? ? .VerticalAlignment = xlCenter
? ? .WrapText = False
? ? .Orientation = 0
? ? .AddIndent = False
? ? .IndentLevel = 0
? ? .ShrinkToFit = False
? ? .ReadingOrder = xlContext
? ? .MergeCells = True
? End With
? Range("K3:K4").Select
? Selection.Merge
? With Selection
? ? .HorizontalAlignment = xlCenter
? ? .VerticalAlignment = xlCenter
? ? .WrapText = False
? ? .Orientation = 0
? ? .AddIndent = False
? ? .IndentLevel = 0
? ? .ShrinkToFit = False
? ? .ReadingOrder = xlContext
? ? .MergeCells = True
? End With
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''邊框設置''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
? Range("A3:K" & (r + 2)).Select
? Selection.Borders(xlDiagonalDown).LineStyle = xlNone
? Selection.Borders(xlDiagonalUp).LineStyle = xlNone
? With Selection.Borders(xlEdgeLeft)
? ? .LineStyle = xlContinuous
? ? .ColorIndex = 0
? ? .TintAndShade = 0
? ? .Weight = xlThin
? End With
? With Selection.Borders(xlEdgeTop)
? ? .LineStyle = xlContinuous
? ? .ColorIndex = 0
? ? .TintAndShade = 0
? ? .Weight = xlThin
? End With
? With Selection.Borders(xlEdgeBottom)
? ? .LineStyle = xlContinuous
? ? .ColorIndex = 0
? ? .TintAndShade = 0
? ? .Weight = xlThin
? End With
? With Selection.Borders(xlEdgeRight)
? ? .LineStyle = xlContinuous
? ? .ColorIndex = 0
? ? .TintAndShade = 0
? ? .Weight = xlThin
? End With
? With Selection.Borders(xlInsideVertical)
? ? .LineStyle = xlContinuous
? ? .ColorIndex = 0
? ? .TintAndShade = 0
? ? .Weight = xlThin
? End With
? With Selection.Borders(xlInsideHorizontal)
? ? .LineStyle = xlContinuous
? ? .ColorIndex = 0
? ? .TintAndShade = 0
? ? .Weight = xlThin
? End With
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''列寬設置''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
? Columns("A:A").ColumnWidth = 15.14
? Columns("B:B").ColumnWidth = 18.57
? Columns("C:C").ColumnWidth = 4.71
? Range("D:G,I:J").Style = "Comma"
? Range("D:G,I:J").ColumnWidth = 16.86
? Columns("K:K").ColumnWidth = 7
? Columns("H:H").ColumnWidth = 10.43
? ActiveWindow.View = xlPageBreakPreview
? ActiveWindow.Zoom = 100
? ActiveSheet.Name = hc
? '標題頂端行
? With ActiveSheet.PageSetup
? ? .PrintTitleRows = "$1:$4"
? ? .PrintTitleColumns = ""
? End With
? '打印區(qū)域
? ActiveSheet.PageSetup.PrintArea = "$A$1:$K$" & r + 2
? '頁面設置，這里好麻煩，只支持硬編碼，不支持變量，至少我不會 0_0
? With ActiveSheet.PageSetup
? ? .LeftHeader = ""
? ? .CenterHeader = "&""宋體,加粗""&22銀行存款日記賬"
? ? .RightHeader = ""
? ? .LeftFooter = ""
? ? .CenterFooter = ""
? ? .RightFooter = "&P/&N"
? ? .LeftMargin = Application.InchesToPoints(0.748031496062992)
? ? .RightMargin = Application.InchesToPoints(0.551181102362205)
? ? .TopMargin = Application.InchesToPoints(0.590551181102362)
? ? .BottomMargin = Application.InchesToPoints(0.393700787401575)
? ? .HeaderMargin = Application.InchesToPoints(0.196850393700787)
? ? .FooterMargin = Application.InchesToPoints(0.196850393700787)
? ? .PrintHeadings = False
? ? .PrintGridlines = False
? ? .PrintComments = xlPrintNoComments
? ? .CenterHorizontally = False
? ? .CenterVertically = False
? ? .Orientation = xlLandscape
? ? .Draft = False
? ? .PaperSize = xlPaperA4
? ? .FirstPageNumber = xlAutomatic
? ? .Order = xlDownThenOver
? ? .BlackAndWhite = False
? ? .Zoom = False
? ? .FitToPagesWide = 1
? ? .FitToPagesTall = 9999
? ? .PrintErrors = xlPrintErrorsDisplayed
? ? .OddAndEvenPagesHeaderFooter = False
? ? .DifferentFirstPageHeaderFooter = False
? ? .ScaleWithDocHeaderFooter = True
? ? .AlignMarginsHeaderFooter = False
? ? .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
? '導出為PDF格式，最小格式，包含文檔屬性，不忽略打印區(qū)域，不打開。
? ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFName, Quality:=xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End Sub
