超难问题,一般人解决不了!

Question

strx="打印字符"
for i=1 to 100 setp 2
Open "LPT1:" For Binary Access Write As #1
        Put #1, , strx
        Close #1
next这样超过15条就会出错.请问如何解决啊.谢谢!

Answer 1

Private Sub Command3_Click()
If Not (Adodc1.Recordset.BOF Or Adodc1.Recordset.EOF) Then
message = MsgBox("打印当前显示的记录吗？？？ ", 36, "Print")
On Error GoTo my_end
If message = vbYes Then '确认打印
con = Adodc1.Recordset.RecordCount
Adodc1.Recordset.MoveLast
Adodc1.Recordset.MoveFirst
Dim fnt As Single, strx As Integer, stry As Integer, strx1 As Integer, stry1 As Integer, linw As Integer, p As Integer
Static a(6) As Integer '打印的列数
a(0) = 1200: a(1) = 1200: a(1) = 1200: a(2) = 1200: a(3) = 1000: a(4) = 1000: a(5) = 800: a(6) = 2800 '计算列宽
kan = a(0) + a(1) + a(2) + a(3) + a(4) + a(5) + a(6) + 1000 '计算表格总宽度
strx = 200: strx1 = 200: stry = 1400: stry1 = 1400 'X,Y方向起始位置
page1 = 50: linw = 240: p = 0: Printer.FontName = "宋体": fnt = 10 '每页行数'行高'计算行数'字体'字体大小
dd = My_Print(4000, 700, 18, "会员详细记录") '打印标题
Dim txt As String
For i = 0 To 6 Step 1
Select Case i
       Case 0: txt = "姓名"
       Case 1: txt = "开户日期"
       Case 2: txt = "卡号"
       Case 3: txt = "金额"
       Case 4: txt = "机时"
       Case 5: txt = "经办人"
       Case 6: txt = "备注"
End Select
dd = My_Print(strx, stry, 12, txt) '打印字段
strx = strx + a(i)
Next
stry = stry + linw + 100
'''''''''''''''''''''''''''''打印表格
For j = 1 To con Step 1 '总打印行数
strx = strx1
Printer.Line (strx - 50, stry - 30)-(strx + kan - 10, stry - 30)
p = p + 1
For i = 0 To 6
   DataGrid1.Col = i
   If i = 6 Then
      dd = My_Print(strx, stry, fnt, Replace(DataGrid1.Text, Chr(13) + Chr(10), " ")) '防止折行
   Else
      dd = My_Print(strx, stry, fnt, DataGrid1.Text)
   End If
   strx = strx + a(i)
Next
Printer.Line (strx1 - 50, stry + linw - 30)-(strx1 + kan - 10, stry + linw - 30)
If j <> con Then
DataGrid1.Row = DataGrid1.Row + 1
End If
If p = page1 Then
p = 0: stry = 100: Printer.NewPage
Else
stry = stry + linw
End If
Next
'''''''''''''''''''''''''''''打印表格
''''''''''''''''''''打印统计报表
stry = stry + linw
For i = 0 To List1.ListCount - 1 Step 1
If p = page1 Then
p = 0: stry = 100: Printer.NewPage
Else
stry = stry + linw
p = p + 1
End If
List1.ListIndex = i
dd = My_Print(1000, stry, 12, List1.Text)
Select Case List1.ListCount
       Case Is > 2
           If i = List1.ListCount - 3 Then
              dd = My_Print(6500, stry, 12, Label3.Caption)
           ElseIf i = List1.ListCount - 2 Then
                  dd = My_Print(6500, stry, 12, Label4.Caption)
           ElseIf i = List1.ListCount - 1 Then
                  dd = My_Print(6500, stry, 12, "打印时间：" + CStr(Now))
           End If
       Case 2
           If i = 0 Then
              dd = My_Print(6500, stry, 12, Label3.Caption)
           ElseIf i = 1 Then
                  dd = My_Print(6500, stry, 12, Label4.Caption)
           End If
       Case 1
           If i = 0 Then
              dd = My_Print(6500, stry, 12, Label3.Caption)
           End If
End Select
Next
List1.ListIndex = -1
For i = 1 To 3 - List1.ListCount Step 1
If p = page1 Then
p = 0: stry = 100: Printer.NewPage
Else
stry = stry + linw
p = p + 1
End If
If List1.ListCount = 2 And i = 1 Then
       dd = My_Print(6500, stry, 12, "打印时间：" + CStr(Now))
ElseIf List1.ListCount = 1 And i = 1 Then
       dd = My_Print(6500, stry, 12, Label4.Caption)
ElseIf List1.ListCount = 1 And i = 2 Then
       dd = My_Print(6500, stry, 12, "打印时间：" + CStr(Now))
ElseIf List1.ListCount = 0 And i = 1 Then
       dd = My_Print(6500, stry, 12, Label3.Caption)
ElseIf List1.ListCount = 0 And i = 2 Then
       dd = My_Print(6500, stry, 12, Label4.Caption)
ElseIf List1.ListCount = 0 And i = 3 Then
       dd = My_Print(6500, stry, 12, "打印时间：" + CStr(Now))
End If
Next
''''''''''''''''''''打印统计报表
Printer.EndDoc '打印结束
End If '确认打印
If False Then '''错误处理
my_end:
MsgBox " 当前打印机的安装有问题，请重新安装打印机的驱动程序后再试   ", 48, "Message"
End If '''错误处理
End If
End SubFunction My_Print(X As Integer, Y As Integer, font As Single, txt As String)
Printer.CurrentX = X
Printer.CurrentY = Y
Printer.FontBold = False
Printer.FontSize = font
Printer.Print txt
End Function

Answer 2

dim filelin as long
filelin=freefile
strx="打印字符"
for i=1 to 100 setp 2
Open "LPT1:" For Binary Access Write As filelin
        Put filelin, , strx
        Close filelin
next

Answer 3

楼上的，把filelin=freefile放到循环里面去

Answer 4

dim filelin as long
filelin=freefile
strx="打印字符"
Open "LPT1:" For Binary Access Write As filelin
for i=1 to 100 setp 2
        Put filelin, , strx
next
Close filelin

Answer 5

For filelin = 1 To 100 Step 2
Open "LPT1:" For Binary Access Write As filelin
        Put filelin, , strx
        Close filelin
Next
故障依旧,是不是传送文件太快的原因.打印机只能排那么多.?

Answer 6

dim filelin as long
filelin=freefile
strx="打印字符"
Open "LPT1:" For Binary Access Write As filelin
for i=1 to 100 setp 2
        Put filelin, , strx
next
Close filelin
出错,文件已经打开

Answer 7

For filelin = 1 To 100 Step 2
Open "LPT1:" For Binary Access Write As filelin
        Put filelin, , strx
     Next
Close filelin
这样错误还是跟以前一样,52错误

Answer 8

Function My_Print(X As Integer, Y As Integer, font As Single, txt As String)
Printer.CurrentX = X
Printer.CurrentY = Y
Printer.FontBold = False
Printer.FontSize = font
Printer.Print txt
End FunctionFor filelin = 1 To 100 Step 2
 My_Print 200*filelin, 1400, 12, "打印字符"
Next

Answer 9

我不能用PRINTER.因为我写了另一种打印机文本.
有没有另一种循环可以啊.
或在中间放些文体.因为我发现用按扭的方式,一个一个的打不会出现问题

Answer 10

限定一个缓冲大小（比如1K），
当输出数据达到缓冲大小后，
在循环中执行一次暂停，用API

Answer 11

Next 前边加一个 Doevents
给机器时间来处理打印缓冲。

Answer 12

strx="打印字符"
Open "LPT1:" For Binary Access Write As #1
for i=1 to 100 setp 2
    Put #1, , strx
    doevents
next
Close #1

Answer 13

息夫人,加打印缓冲可能是可以的.因为你我用时间控件,timer=500,打印正常.
doevents这个可以加到这么久吗？,息体怎么加,能给个详细说明吗？谢谢了.
老鸟的行,但我不能这么用,不能把FOR放在那个位置,因为我的srtx要变的.

Answer 14

dim filelin as long
filelin=freefile
Open "LPT1" For Output As #filelin
Print #filelin, strx
Close #filelin

Answer 15

延时500毫秒：WaitFor 500调用前请在工程中加入以下模块
--------------------------------------
'延时程序：
Private Declare Function CreateEvent Lib "kernel32.dll" Alias "CreateEventA" ( _
     ByRef sa As Long, _
     ByVal bManualReset As Long, _
     ByVal bInitialState As Long, _
     ByVal lpName As String) As Long
Private Declare Function WaitForSingleObject Lib "kernel32.dll" ( _
     ByVal hHandle As Long, _
     ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" ( _
     ByVal hObject As Long) As Long
Private Const INFINITE As Long = &HFFFFFFFF
Private hEvent As LongFunction WaitFor(ByVal nMilliseconds As Long)
    hEvent = CreateEvent(ByVal 0, False, False, "")
   WaitForSingleObject hEvent, nMilliseconds
    CloseHandle hEvent
End Function

Answer 16

不过延时500毫秒：WaitFor 500 会死机,WaitFor 50就好了.