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 '模板累計列寬Dim adjustScale As Double '調(diào)整比例'Dim modelCountInOnePage As Long '一頁打印幾個單據(jù)模板Dim BreakColumn As Long '垂直分頁符位置Dim FirstPageSumColumnWidth As Double '累計首頁列寬Dim ColumnsInOnePage As Long '每頁打印多少行Dim i As Long, m As Long '行號With ModelSheetIf Application.WorksheetFunction.Count(.Cells) > 0 Then'計數(shù)防止計算行號發(fā)生錯誤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ù)和累計列寬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 "垂直分頁符個數(shù)："; .VPageBreaks.Count'先判斷是否有垂直分頁符，如果沒有則退出If .VPageBreaks.Count > 0 Then'獲取第一頁與第二頁分頁符所在的單元格BreakColumn = .VPageBreaks(1).Location.ColumnDebug.Print "首頁分頁符所在的行號："; BreakColumn'累計第一頁所有行的高度i = 1Do While i < BreakColumnFirstPageSumColumnWidth = FirstPageSumColumnWidth + .Columns(i).ColumnWidthi = i + 1Loop'StopDebug.Print FirstPageSumColumnWidth'獲取第一頁最后一個成績單末尾的空白行行號If IsMissing(modelCountInOnePage) ThenColumnsInOnePage = BreakColumnDo While Application.WorksheetFunction.Count(.Columns(ColumnsInOnePage)) > 0ColumnsInOnePage = ColumnsInOnePage - 1LoopDebug.Print "首頁最后一個成績單截止行號1："; ColumnsInOnePageColumnsInOnePage = Application.WorksheetFunction.Max(BreakColumn, modelColumnCount)Debug.Print "首頁最后一個成績單截止行號2："; ColumnsInOnePagemodelCountInOnePage = ColumnsInOnePage / modelColumnCountDebug.Print "每一頁放置多少個單據(jù)："; modelCountInOnePageEnd If'計算調(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 '逐個單據(jù)調(diào)整Next iEnd IfEnd WithEnd Sub

　　

轉(zhuǎn)載于:https://www.cnblogs.com/nextseven/p/8970698.html

總結(jié)

以上是生活随笔為你收集整理的20180429 xlVBA套打单据自适应列宽的全部內(nèi)容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網(wǎng)站內(nèi)容還不錯，歡迎將生活随笔推薦給好友。