打印出错，求大神帮助修改，谢谢。

花菲飞

角纸工作表中一键打印，之前一直能正常打印，不知道什么现在出错，无法打印设置工作中A11内容信息进行打印（目前无法打印设置工作中A11的内容）求大神帮助修改，谢谢。

quqiyuan

参与一下，仅供参考。。。

quqiyuan

代码如下。。。
Sub 台角纸_按钮1_Click()
    Set d = CreateObject("scripting.dictionary")
    Application.ScreenUpdating = False
    Sheets("台角纸").Select
    arr = [a1].Resize(50, 14)
    brr = Sheets("考场安排").[a1].CurrentRegion
    x = 7
    y = 8
    For j = 2 To UBound(brr)
        If Len(brr(j, x)) > 0 Then
            If Not d.exists(brr(j, x)) Then
                Set d(brr(j, x)) = CreateObject("scripting.dictionary")
            End If
            d(brr(j, x))(Int(brr(j, y))) = j
        End If
    Next j
    k = [l1]
    If k <> "" Then
        Call clear_data(arr)
        r = 2
        c = 1
'        For j = 1 To d(k).Count
            For i = 1 To d(k).Count
                x1 = WorksheetFunction.Small(d(k).keys, i)
                rx = d(k)(x1)
                arr(r + 1, c + 1) = brr(rx, 2)
                arr(r, c + 1) = brr(rx, 3)
                arr(r + 1, c + 3) = brr(rx, 4)
                arr(r + 2, c + 1) = brr(rx, x)
                arr(r + 2, c + 3) = x1
                arr(r + 3, c + 1) = brr(rx, 9)
                arr(r + 3, c + 3) = brr(rx, 10)
                c = c + 5
                If c > 14 Then
                    r = r + 5
                    c = 1
                    If r > 47 Then
                        [a1].Resize(50, 14) = arr
                        r = 2
                        [a1].Resize(50, 14).PrintOut
                        Call clear_data(arr)
                    End If
                End If
            Next i
'        Next j
        [a1].Resize(50, 14) = arr
        If r < 48 Then [a1].Resize(50, 14).PrintOut
    Else
        For Each k In d.keys
        
            Call clear_data(arr)
            r = 2
            c = 1
'            For j = 1 To d(k).Count
                For i = 1 To d(k).Count
                    x1 = WorksheetFunction.Small(d(k).keys, i)
                    rx = d(k)(x1)
                    arr(r + 1, c + 1) = brr(rx, 2)
                    arr(r, c + 1) = brr(rx, 3)
                    arr(r + 1, c + 3) = brr(rx, 4)
                    arr(r + 2, c + 1) = brr(rx, x)
                    arr(r + 2, c + 3) = x1
                    arr(r + 3, c + 1) = brr(rx, 9)
                    arr(r + 3, c + 3) = brr(rx, 10)
                    c = c + 5
                    If c > 14 Then
                        r = r + 5
                        c = 1
                        If r > 47 Then
                            [a1].Resize(50, 14) = arr
                            r = 2
                            [l1] = k
                            [a1].Resize(50, 14).PrintOut
                            Call clear_data(arr)
                        End If
                    End If
                Next i
'            Next j
            [a1].Resize(50, 14) = arr
            If r < 48 Then [l1] = k: [a1].Resize(50, 14).PrintOut
        Next k
    End If
    Call clear_data(arr)
    [a1].Resize(50, 14) = arr
    Application.ScreenUpdating = True
End Sub
Sub clear_data(arr)
    For j = 2 To UBound(arr)
        For i = 1 To UBound(arr, 2) Step 5
            If Len(arr(j, i)) > 0 Then
                arr(j, i + 1) = ""
                arr(j, i + 3) = ""
            End If
        Next i
    Next j
End Sub

花菲飞

quqiyuan 发表于 2024-10-4 11:38
代码如下。。。
Sub 台角纸_按钮1_Click()
    Set d = CreateObject("scripting.dictionary")

谢谢您的帮助。