20180429 xlVBA套打单据自适应列宽
生活随笔
收集整理的這篇文章主要介紹了
20180429 xlVBA套打单据自适应列宽
小編覺(jué)得挺不錯(cuò)的,現(xiàn)在分享給大家,幫大家做個(gè)參考.
Sub TestAutoAdjustColumnWidthBaseOnModel()Set ModelSheet = ThisWorkbook.Worksheets("單據(jù)模板")Set PrintSheet = ThisWorkbook.Worksheets("批量打印")AutoAdjustColumnWidthBaseOnModel ModelSheet, PrintSheet
End Sub
Sub AutoAdjustColumnWidthBaseOnModel(ByVal ModelSheet As Worksheet, ByVal PrintSheet As Worksheet, Optional modelCountInOnePage As Variant)Dim ModelRng As Range '模板單元格Dim modelColumnWidth() As Double '模板列寬數(shù)據(jù)Dim modelColumnCount As Long '模板行數(shù)Dim sumModelColumnWidth As Double '模板累計(jì)列寬Dim adjustScale As Double '調(diào)整比例'Dim modelCountInOnePage As Long '一頁(yè)打印幾個(gè)單據(jù)模板Dim BreakColumn As Long '垂直分頁(yè)符位置Dim FirstPageSumColumnWidth As Double '累計(jì)首頁(yè)列寬Dim ColumnsInOnePage As Long '每頁(yè)打印多少行Dim i As Long, m As Long '行號(hào)With ModelSheetIf Application.WorksheetFunction.Count(.Cells) > 0 Then'計(jì)數(shù)防止計(jì)算行號(hào)發(fā)生錯(cuò)誤EndRow = .Cells.Find("*", .Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row + 1EndCol = .Cells.Find("*", .Cells(1, 1), xlValues, xlWhole, xlByColumns, xlPrevious).Column'獲取單據(jù)模板單元格區(qū)域Set ModelRng = .Range(.Cells(1, 1), .Cells(EndRow, EndCol))Debug.Print ModelRng.Address'獲取模板單元格行數(shù)和累計(jì)列寬modelColumnCount = ModelRng.Columns.CountReDim modelColumnWidth(1 To modelColumnCount)sumModelColumnWidth = 0For i = 1 To modelColumnCountmodelColumnWidth(i) = ModelRng.Columns(i).ColumnWidthsumModelColumnWidth = sumModelColumnWidth + ModelRng.Columns(i).ColumnWidthNext iDebug.Print sumModelColumnWidth'記錄列寬End IfEnd With'With PrintSheetDebug.Print "垂直分頁(yè)符個(gè)數(shù):"; .VPageBreaks.Count'先判斷是否有垂直分頁(yè)符,如果沒(méi)有則退出If .VPageBreaks.Count > 0 Then'獲取第一頁(yè)與第二頁(yè)分頁(yè)符所在的單元格BreakColumn = .VPageBreaks(1).Location.ColumnDebug.Print "首頁(yè)分頁(yè)符所在的行號(hào):"; BreakColumn'累計(jì)第一頁(yè)所有行的高度i = 1Do While i < BreakColumnFirstPageSumColumnWidth = FirstPageSumColumnWidth + .Columns(i).ColumnWidthi = i + 1Loop'StopDebug.Print FirstPageSumColumnWidth'獲取第一頁(yè)最后一個(gè)成績(jī)單末尾的空白行行號(hào)If IsMissing(modelCountInOnePage) ThenColumnsInOnePage = BreakColumnDo While Application.WorksheetFunction.Count(.Columns(ColumnsInOnePage)) > 0ColumnsInOnePage = ColumnsInOnePage - 1LoopDebug.Print "首頁(yè)最后一個(gè)成績(jī)單截止行號(hào)1:"; ColumnsInOnePageColumnsInOnePage = Application.WorksheetFunction.Max(BreakColumn, modelColumnCount)Debug.Print "首頁(yè)最后一個(gè)成績(jī)單截止行號(hào)2:"; ColumnsInOnePagemodelCountInOnePage = ColumnsInOnePage / modelColumnCountDebug.Print "每一頁(yè)放置多少個(gè)單據(jù):"; modelCountInOnePageEnd If'計(jì)算調(diào)整比例adjustScale = FirstPageSumColumnWidth / (sumModelColumnWidth * modelCountInOnePage)Debug.Print adjustScale'調(diào)整EndCol = .Cells.Find("*", .Cells(1, 1), xlValues, xlWhole, xlByColumns, xlPrevious).Columnm = 0For i = 1 To EndColm = m + 1.Columns(i).ColumnWidth = modelColumnWidth(m) * adjustScaleIf m = modelColumnCount Then m = 0 '逐個(gè)單據(jù)調(diào)整Next iEnd IfEnd WithEnd Sub
轉(zhuǎn)載于:https://www.cnblogs.com/nextseven/p/8970698.html
總結(jié)
以上是生活随笔為你收集整理的20180429 xlVBA套打单据自适应列宽的全部?jī)?nèi)容,希望文章能夠幫你解決所遇到的問(wèn)題。
- 上一篇: 《代码大全2》读书笔记(七)
- 下一篇: 阮一峰:Flex 布局教程