欢迎光临散文网 会员登陆 & 注册

【VBA视频合集】Word VBA教程 Excel VBA教程 WordVBA教

2023-08-02 18:31 作者:我也不懂1111  | 我要投稿

以下代码看得懂的都看得懂,看不懂的还是看不懂,仅供参考。正常情况下在机器上是跑不了的,因为引用到了具体数据,是批量设置银行存款日记账Excel页面排版并转为PDF文件的示例。

Sub DepositJournal_USD_x_PDF()


  Dim n$, cc$, hc$, at$, h$, PDFName$

  Dim r&, c&

  Dim P$

  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)

   

  hc = Application.WorksheetFunction.XLookup(n, _

  Sheets("Idx-x").Range("A:A"), _

  Sheets("Idx-x").Range("C:C"), , , -1)

   

  r = ActiveSheet.UsedRange.Rows.Count

  c = ActiveSheet.UsedRange.Columns.Count

   

  PDFName = ThisWorkbook.Path & "\..\PDF\日记账\" & hc & ".pdf"

  'PDFName = "E:\BaiduSyncdisk\Work\2023\July\罗仁梁\账套\百营\明细账\PDF\" & hc & ".pdf"

  'Range("F:F,H:H,K:K,O:O,P:P").Delete Shift:=xlToLeft

  'Range("G:G,I:I,L:L,Q:R").Delete Shift:=xlToLeft

  '插入两行

  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写入“科目",合并A1:B1

  Range("A1").Select

  ActiveCell.FormulaR1C1 = "科目"

  'Range("A1:B1").Select

  With Selection

    .HorizontalAlignment = xlCenter

    .VerticalAlignment = xlCenter

    .WrapText = False

    .Orientation = 0

    .AddIndent = False

    .IndentLevel = 0

    .ShrinkToFit = False

    .ReadingOrder = xlContext

    .MergeCells = False

  End With

  'Selection.Merge


  'B1写入科目内容,合并C1:I1

  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

   

  '打印区域

  ActiveSheet.PageSetup.PrintArea = "$A$1:$K$" & r + 2

   

  '页面设置

  With ActiveSheet.PageSetup

    .LeftHeader = ""

'    .CenterHeader = "&""宋体,加粗""&22现金日记账"

    .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

  ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFName, Quality:=xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

End Sub


【VBA视频合集】Word VBA教程 Excel VBA教程 WordVBA教的评论 (共 条)

分享到微博请遵守国家法律