vba 打印机问题

liuyi3004

偶用vba编了个识别图框块批量打图的程序，遇到两个问题，1，能预览图，但打印不出来；2，预览出来的是空白；请论坛里的各位高手指点指点，不胜感激，源码如下

用户窗体主要有两个combobox，两个optionbuttun，两个commandbuttun

Private Sub Command1_Click()
 On Error Resume Next
Dim plotname As Variant
Dim plotstyle As Variant
Dim point1 As Variant, point2 As Variant
Dim ent As AcadEntity
Dim i As Integer
Dim j  As Integer
Dim scs As String
j = 0
If Com1.ListIndex < 0 Or Com2.ListIndex < 0 Then
    MsgBox "请选择打印机和样式", vbOKOnly, "注意！"
Else
    Me.Hide
    plotname = Com1.Text
    plotstyle = Com2.Text
   
 
   
   
    For Each ent In ThisDrawing.Application.ActiveDocument.ModelSpace
        If TypeOf ent Is AcadBlockReference Then
            ent.GetBoundingBox point1, point2
            ReDim Preserve point1(0 To 1)
            ReDim Preserve point2(0 To 1)
            Dim a As Double, b As Double
            a = Abs(Abs(point1(0)) - Abs(point2(0)))
            b = Abs(Abs(point1(1)) - Abs(point2(1)))
            If a > 0 Then
             scs = tk(a, b)
             If scs <> "0" Then
                 If scs <> "A4" Then
                
                    If Opt1.Value = True Then
                    scs = "A3"
                    End If
                 End If
                
                 With ThisDrawing.ActiveLayout
                
                 .SetWindowToPlot point1, point2
                
                 .ConfigName = plotname
                 .StyleSheet = plotstyle
                 .StandardScale = acScaleToFit
                 .PaperUnits = acMillimeters
                 .CanonicalMediaName = scs
                
                 .GetWindowToPlot point1, point2
                
                 If scs = "A4" Then
                 .PlotRotation = ac0degrees
                 Else
                 .PlotRotation = ac90degrees
                 End If
                 End With
                
                 If i <> 6 Then
                     ThisDrawing.Plot.DisplayPlotPreview acFullPreview
                     i = MsgBox("是否取消预览？" & "“是”取消预览全部打印，“否”继续预览，“取消”退出程序", vbYesNoCancel, "注意")
                     If i = 2 Then
                     j = j + 1
                     Exit For
                     End If
                 End If
                 j = j + 1
                  ThisDrawing.ActiveLayout.PlotType = acWindow
                  ThisDrawing.Application.ActiveDocument.SetVariable "BACKGROUNDPLOT", 0
                  Debug.Print scs & ":" & a & "X" & b
             End If
            End If
        End If
    Next ent
    MsgBox "本次打印" & j & " 张图纸 ", vbOKOnly, "恭喜"
    Me.Show
  
End If
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim plotDevices As Variant
Dim plotsheets As Variant
    plotDevices = ThisDrawing.ActiveLayout.GetPlotDeviceNames()
    plotsheets = ThisDrawing.ActiveLayout.GetPlotStyleTableNames()
    Dim x As Integer
    Com1.Clear
    Com2.Clear
    For x = LBound(plotDevices) To UBound(plotDevices)
        Com1.AddItem plotDevices(x)
    Next
    For x = LBound(plotsheets) To UBound(plotsheets)
        Com2.AddItem plotsheets(x)
    Next
    Opt1.Value = True
End Sub
Function tk(xa As Double, ya As Double)
On Error Resume Next
tk = "0"
If xa < ya Then
    If xa Mod 210 = 0 And ya Mod 297 = 0 Then
    tk = "A4"
    End If
Else
    If xa Mod 1189 = 0 And ya Mod 841 = 0 Or xa * 2 Mod 1189 = 0 And ya * 2 Mod 841 = 0 Then
        tk = "A0"
    ElseIf xa Mod 841 = 0 And ya Mod 594 = 0 Or xa * 2 Mod 841 = 0 And ya * 2 Mod 594 = 0 Then
            tk = "A1"
        ElseIf xa Mod 594 = 0 And ya Mod 420 = 0 Or xa * 2 Mod 594 = 0 And ya * 2 Mod 420 = 0 Then
                tk = "A2"
            ElseIf xa Mod 420 = 0 And ya Mod 297 = 0 Or xa * 2 Mod 420 = 0 And ya * 2 Mod 297 = 0 Then
                    tk = "A3"
    End If
End If
End Function

补充 原程序如下