用户表单多页打印问题：长文本无法完整分页打印

表单文本框包含3634个字符，超出A4单页可容纳的3500字符上限，需将超出部分打印至第二页。但运行以下VBA代码后，仅打印出第一页，剩余634字符未按预期打印在第二页。

Private Sub Udskriv_Click()

' Skift til det aktive ark
Dim ws As Worksheet
Set ws = ActiveSheet

' Navn på Frame
Dim frameNavn As String
frameNavn = "Redegørelse"

' Gem skærmopdateringens aktuelle tilstand
Dim oldScreenUpdating As Boolean
oldScreenUpdating = Application.ScreenUpdating

' Deaktiver skærmopdatering for at fremskynde udskriften
Application.ScreenUpdating = False

' Print formularen
Dim tekst As String
tekst = TextBox1.text

Dim antalSider As Integer
antalSider = Len(tekst) / 3500 ' Antager at hver side kan rumme 3500 karakterer

Dim i As Integer ' Tilføjet erklæring af variabel i
For i = 1 To antalSider
    ' Opret en ny kopi af formularen
    Dim nyForm As Object
    Set nyForm = New Redegørelse
    'nyForm.Show

    ' Indstil tekstboks1 i den nye kopi til at indeholde en del af teksten
    Dim startIdx As Integer
    startIdx = (i - 1) * 3500
    Dim endIdx As Integer
    endIdx = i * 3500 + 523
    'nyForm.TextBox1.text = Mid(tekst, startIdx + 1, endIdx - startIdx)

    ' Print den nye kopi
    nyForm.PrintForm
       
    Unload nyForm ' Tilføjet koden for at lukke den nye kopi
Next i

Application.Wait (Now + TimeValue("0:00:01")) ' Tilføjet en ventekode på 1 sekund

' Gendan skærmopdateringens tidligere tilstand
Application.ScreenUpdating = oldScreenUpdating

' Skift tilbage til det aktive ark
ws.Activate
End Sub

问题分析 #

1. 页数计算错误：antalSider = Len(tekst) / 3500 使用普通除法，当字符数为3634时，计算结果为1.038，赋值给Integer类型变量会自动取整为1，导致循环仅执行一次，不会处理第二页。
2. 文本截取逻辑失效：关键的文本框赋值语句nyForm.TextBox1.text = Mid(...)被注释，同时endIdx = i * 3500 + 523的计算逻辑完全错误，导致新表单的文本框为空，无法打印剩余内容。

修正后的代码 #

Private Sub Udskriv_Click()
    Dim ws As Worksheet
    Set ws = ActiveSheet

    Dim oldScreenUpdating As Boolean
    oldScreenUpdating = Application.ScreenUpdating
    Application.ScreenUpdating = False

    Dim tekst As String
    tekst = TextBox1.Text
    Dim totalChars As Integer
    totalChars = Len(tekst)
    Dim charsPerPage As Integer
    charsPerPage = 3500
    ' 向上取整计算总页数
    Dim antalSider As Integer
    antalSider = WorksheetFunction.Ceiling(totalChars / charsPerPage, 1)

    Dim i As Integer
    For i = 1 To antalSider
        Dim nyForm As Object
        Set nyForm = New Redegørelse

        Dim startIdx As Integer
        startIdx = (i - 1) * charsPerPage + 1
        ' 计算当前页的字符长度：最后一页取剩余字符数，其余页取3500
        Dim pageLength As Integer
        pageLength = IIf(i = antalSider, totalChars - (i - 1) * charsPerPage, charsPerPage)
        
        ' 给新表单的文本框赋值对应分段的文本
        nyForm.TextBox1.Text = Mid(tekst, startIdx, pageLength)
        
        ' 打印表单
        nyForm.PrintForm
        Unload nyForm
    Next i

    Application.ScreenUpdating = oldScreenUpdating
    ws.Activate
End Sub

关键修改说明 #

• 用WorksheetFunction.Ceiling向上取整计算总页数，确保只要有超出字符就会生成新页面
• 修复文本截取逻辑，根据当前页是否为最后一页计算要截取的字符长度
• 取消文本框赋值语句的注释，确保新表单加载对应分段的文本

内容的提问来源于stack exchange，提问作者MaKo