У меня есть форма, которая постоянно меняется, и у меня есть поля текста в столбце "C".Также некоторый текст в ячейках столбца «C» слишком длинный, поэтому я обертываю его своим VBA.Я хочу сделать условные разрывы страниц, которые будут читать мою область печати и вставлять разрывы страниц после каждой пустой строки перед заголовком.Мой код VBA, приведенный ниже, работает нормально, за исключением переноса текста.Таким образом, проблема в том, что: если я установлю PgSize = 91 в Sub FitGroupsToPage() (это количество строк может быть помещено на каждой странице) в 91 и не перенесу мой текст, тогда все будет работать нормально.Однако текст должен быть обернут, чтобы соответствовать моей странице.Тогда есть не 91 строка, а меньше, в зависимости от длины текста в обернутых ячейках.Таким образом, число 91 является динамическим каждый раз после сокрытия и упаковки Sub FitMyTextPlease() и Sub HideMyEmptyRows() и Sub SetPrintArea().Количество строк также может быть разным на каждой странице (в зависимости от того, сколько текста там обернуто на каждой странице).Есть идеи, как решить эту проблему?
Sub FitMyTextPlease()
Application.ScreenUpdating = False
ThisWorkbook.Sheets("Print version").PageSetup.CenterHeader = "&""Times New Roman,Bold""&12 " & Range("Data!V28").Text & Chr(13) & Chr(13) & " " & "&""Times New Roman,Normal""&12 " & Range("Data!V30").Text
'ThisWorkbook.Sheets("Print version").PageSetup.CenterHeader = Range("Data!V28").Text
ThisWorkbook.Sheets("Print version").Select
With ActiveWorkbook.ActiveSheet
With .Cells.Rows
.WrapText = True
.VerticalAlignment = xlCenter
.EntireRow.AutoFit
End With '.Cells.Rows
.Columns.EntireColumn.AutoFit
End With 'sheet
Application.ScreenUpdating = True
End Sub
Sub HideMyEmptyRows()
Dim myRange As Range
Dim cell As Range
Application.ScreenUpdating = False
Set myRange = ThisWorkbook.Sheets("Print version").Range("Print_Area")
For Each cell In myRange
myRange.Interior.ColorIndex = 0
If cell.HasFormula = True And cell.value = "" And cell.EntireRow.Hidden = False Then Rows(cell.Row).EntireRow.Hidden = True
Next
Application.ScreenUpdating = True
End Sub
Sub SetPrintArea()
Dim ws As Worksheet
Dim lastrow As Long
Set ws = ThisWorkbook.Sheets("Print version")
' find the last row with formatting, to be included in print range
lastrow = ws.UsedRange.SpecialCells(xlCellTypeLastCell).Row
ws.PageSetup.PrintArea = ws.Range("A1:C" & lastrow).Address
End Sub
Sub Printed_Pages_Count()
Range("A1").value = (ActiveSheet.HPageBreaks.Count + 1) * (ActiveSheet.VPageBreaks.Count + 1)
End Sub
Sub FitGroupsToPage()
Dim rStart As Range, rEnd As Range, TestCell As Range
Dim lastrow As Long, PgSize As Integer
Dim n As Integer
PgSize = 91 ' Assumes 91 rows per page
Set rStart = Range("C1")
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
Do
Set TestCell = rStart.Offset(PgSize, 0)
If Len(TestCell) = 0 Or Len(TestCell.Offset(-1, 0)) = 0 Then
Set rEnd = TestCell.End(xlUp)
Else
Set rEnd = TestCell.End(xlUp).End(xlUp)
End If
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=rEnd.Offset(1, 0)
Set rStart = rEnd.Offset(1, 0)
n = n + 1
If n > 1000 Then Exit Sub ' Escapes from an infinite loop if code fails
Loop Until rStart.Row > lastrow - 50
End Sub
Sub FitMyHeadings()
Call FitMyTextPlease
Call HideMyEmptyRows
Call SetPrintArea
Call FitGroupsToPage
Call Printed_Pages_Count
End Sub