📄 frmm_label.frm
字号:
Attribute VB_Name = "FrmM_Label"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Cm As Double
Private Sub Command1_Click(Index As Integer)
Select Case Index
Case 0
If Trim(Text4(0).Text) = "" Then
MsgBox "没有输入订单号！", vbOKOnly + vbExclamation, "打印出错"
Text4(0).SetFocus
Exit Sub
End If
If Option1(0).Value = True Then
If Trim(Text5.Text) = "" Then
MsgBox "没有输入条形码！", vbOKOnly + vbExclamation, "打印出错"
Text5.SetFocus
Exit Sub
End If
End If
On Error Resume Next
Dim cn As New ADODB.Connection
Dim Rec As New ADODB.Recordset
Dim PntCn As New ADODB.Connection
Dim PntRec As New ADODB.Recordset
cn.Open DbConnectSql
Select Case MdlMain.LoginBh
Case "000"
If Trim(Text4(1).Text) <> "" And Trim(Text4(2).Text) <> "" Then
Rec.CursorLocation = adUseClient
Rec.Open "select * from maindb where orderid='" & Trim(Text4(0).Text) & _
"' and pid between '" & Trim(Text4(1).Text) & "' and '" & _
Trim(Text4(2).Text) & "' order by pid", cn, adOpenDynamic, adLockOptimistic
ElseIf Trim(Text4(1).Text) <> "" Then
Rec.CursorLocation = adUseClient
Rec.Open "select * from maindb where orderid='" & Trim(Text4(0).Text) & _
"' and pid ='" & Trim(Text4(1).Text) & "' order by pid", cn, adOpenDynamic, adLockOptimistic
ElseIf Trim(Text4(2).Text) <> "" Then
Rec.CursorLocation = adUseClient
Rec.Open "select * from maindb where orderid='" & Trim(Text4(0).Text) & _
"' and pid='" & Trim(Text4(2).Text) & "' order by pid", cn, adOpenDynamic, adLockOptimistic
Else
Rec.CursorLocation = adUseClient
Rec.Open "select * from maindb where orderid='" & Trim(Text4(0).Text) & _
"' order by pid", cn, adOpenDynamic, adLockOptimistic
End If
Case Else
If Trim(Text4(1).Text) <> "" And Trim(Text4(2).Text) <> "" Then
Rec.CursorLocation = adUseClient
Rec.Open "select * from maindb where orderid='" & Trim(Text4(0).Text) & _
"' and pid between '" & Trim(Text4(1).Text) & "' and '" & _
Trim(Text4(2).Text) & "' and loginuser='" & MdlMain.LoginBh & _
"' order by pid", cn, adOpenDynamic, adLockOptimistic
ElseIf Trim(Text4(1).Text) <> "" Then
Rec.CursorLocation = adUseClient
Rec.Open "select * from maindb where orderid='" & Trim(Text4(0).Text) & _
"' and pid ='" & Trim(Text4(1).Text) & "' and loginuser='" & MdlMain.LoginBh _
& "' order by pid", cn, adOpenDynamic, adLockOptimistic
ElseIf Trim(Text4(2).Text) <> "" Then
Rec.CursorLocation = adUseClient
Rec.Open "select * from maindb where orderid='" & Trim(Text4(0).Text) & _
"' and pid='" & Trim(Text4(2).Text) & "' and loginuser='" & MdlMain.LoginBh _
& "' order by pid", cn, adOpenDynamic, adLockOptimistic
Else
Rec.CursorLocation = adUseClient
Rec.Open "select * from maindb where orderid='" & Trim(Text4(0).Text) & _
"' and loginuser='" & MdlMain.LoginBh & "' order by pid", cn, _
adOpenDynamic, adLockOptimistic
End If
End Select
If Rec.EOF And Rec.BOF Then
cn.Close: Set cn = Nothing
Rec.Close: Set Rec = Nothing
MsgBox "输入的定单号没有可打印数据！", vbOKOnly + vbCritical, "打印出错"
Exit Sub
End If
PntCn.ConnectionString = "provider=microsoft.jet.oledb.4.0;data source=" & _
SysDbPath & "\report97.mdb;jet oledb:database password=tony;"
PntCn.Open
PntCn.Execute "delete * from LabelDB"
PntRec.CursorLocation = adUseClient
PntRec.Open "select * from LabelDB", PntCn, adOpenDynamic, adLockOptimistic
PntCn.BeginTrans
With PntRec
If Option1(0).Value = True Then
Do While Not Rec.EOF
.AddNew
.Fields("startid").Value = Text1.Text
.Fields("endid").Value = Text3.Text
.Fields("orderid").Value = Rec.Fields("orderid")
.Fields("ph").Value = Rec.Fields("ph")
.Fields("xh").Value = Rec.Fields("xh")
.Fields("ys").Value = Rec.Fields("ys")
.Fields("pid").Value = Val(Rec.Fields("pid"))
.Fields("shjm").Value = Rec.Fields("shjm")
.Fields("shjf").Value = Format((Val(Rec.Fields("shjm")) * 36 * 2.54 / 100), "####.#")
.Fields("zhm").Value = Rec.Fields("zhm")
.Update
Rec.MoveNext
Loop
Else
Do While Not Rec.EOF
.AddNew
.Fields("startid").Value = Text2.Text
.Fields("endid").Value = Text3.Text
.Fields("orderid").Value = Rec.Fields("orderid")
.Fields("ph").Value = Rec.Fields("ph")
.Fields("xh").Value = Rec.Fields("xh")
.Fields("ys").Value = Rec.Fields("ys")
.Fields("pid").Value = Val(Rec.Fields("pid"))
.Fields("shjm").Value = Rec.Fields("shjm")
.Fields("shjf").Value = Format((Val(Rec.Fields("shjm")) * 36 * 2.54 / 100), "####.#")
.Fields("zhm").Value = Rec.Fields("zhm")
' Rec.MoveNext
' If Not Rec.EOF Then
.Fields("startid1").Value = Text2.Text
.Fields("endid1").Value = Text3.Text
.Fields("orderid1").Value = Rec.Fields("orderid")
.Fields("ph1").Value = Rec.Fields("ph")
.Fields("xh1").Value = Rec.Fields("xh")
.Fields("ys1").Value = Rec.Fields("ys")
.Fields("pid1").Value = Val(Rec.Fields("pid"))
.Fields("shjm1").Value = Rec.Fields("shjm")
.Fields("shjf1").Value = Format((Val(Rec.Fields("shjm")) * 36 * 2.54 / 100), "####.#")
.Fields("zhm1").Value = Rec.Fields("zhm")
' Else
' GoTo NextRec
' End If
Rec.MoveNext
If Not Rec.EOF Then
.Fields("startid2").Value = Text2.Text
.Fields("endid2").Value = Text3.Text
.Fields("orderid2").Value = Rec.Fields("orderid")
.Fields("ph2").Value = Rec.Fields("ph")
.Fields("xh2").Value = Rec.Fields("xh")
.Fields("ys2").Value = Rec.Fields("ys")
.Fields("pid2").Value = Val(Rec.Fields("pid"))
.Fields("shjm2").Value = Rec.Fields("shjm")
.Fields("shjf2").Value = Format((Val(Rec.Fields("shjm")) * 36 * 2.54 / 100), "####.#")
.Fields("zhm2").Value = Rec.Fields("zhm")
' Else
' GoTo NextRec
' End If
'
' Rec.MoveNext
' If Not Rec.EOF Then
.Fields("startid3").Value = Text2.Text
.Fields("startid3").Value = Text2.Text
.Fields("endid3").Value = Text3.Text
.Fields("orderid3").Value = Rec.Fields("orderid")
.Fields("ph3").Value = Rec.Fields("ph")
.Fields("xh3").Value = Rec.Fields("xh")
.Fields("ys3").Value = Rec.Fields("ys")
.Fields("pid3").Value = Val(Rec.Fields("pid"))
.Fields("shjm3").Value = Rec.Fields("shjm")
.Fields("shjf3").Value = Format((Val(Rec.Fields("shjm")) * 36 * 2.54 / 100), "####.#")
.Fields("zhm3").Value = Rec.Fields("zhm")
Else
GoTo NextRec
End If
NextRec:
.Update
If Not Rec.EOF Then Rec.MoveNext
Loop
End If
End With
PntCn.CommitTrans
PntRec.Close
Set PntRec = Nothing
PntCn.Close
Set PntCn = Nothing
If Option1(0).Value = True Then
'条形码标签打印
Call PrintBarLabel
' Call FrmMain.PrintReport("Pnt4")
ElseIf Option1(1).Value = True Then
'非条形码标签打印
Call FrmMain.PrintReport("Pnt3")
Else
MsgBox "没有选择打印标签类型。", vbOKOnly + vbExclamation, "打印出错"
End If
Case 1
Unload Me
End Select
End Sub
Private Sub Form_Load()
Text1.Text = ""
Text2.Text = "UNITED DRAGON CO.,LTD."
Text3.Text = ""
Text5.Text = ""
Text4(0).Text = ""
Text4(1).Text = ""
Text4(2).Text = ""
Option1(0).Value = True
Cm = 575
Me.Caption = "打印不干胶粘纸（当前用户：" & MdlMain.LoginUser & "）"
End Sub
Private Sub Option1_Click(Index As Integer)
If Option1(0).Value = True Then
Text1.Enabled = True
Text2.Enabled = False
Text3.Enabled = False
Text5.Enabled = True
Else
Text2.Enabled = True
Text3.Enabled = True
Text1.Enabled = False
Text5.Enabled = False
End If
End Sub
' 参数说明:
' strBarCode - 要打印的条形码字符串
' intXPos, intYPos - 打印条形码的左上角坐标(缺省为(0,0)，坐标刻度为:毫米)
' intHeight - 打印高度(缺省为一厘米,坐标刻度为:毫米)
' bolPrintText - 是否打印人工识别字符(缺省为true)
' "0"-"9","A-Z","-","%","$"和"*" 的条码编码格式,总共 40 个字符
Private Sub PrintBarCode(ByVal strBarCode As String, Optional ByVal intXPos As Integer = 0, _
Optional ByVal intYPos As Integer = 0, Optional ByVal intPrintHeight As Integer = 10, _
Optional ByVal bolPrintText As Boolean = True)
Static strBarTable(39) As String
' 初始化条码编码格式表
strBarTable(0) = "001100100" ' 0
strBarTable(1) = "100010100" ' 1
strBarTable(2) = "010010100" ' 2
strBarTable(3) = "110000100" ' 3
strBarTable(4) = "001010100" ' 4
strBarTable(5) = "101000100" ' 5
strBarTable(6) = "011000100" ' 6
strBarTable(7) = "000110100" ' 7
strBarTable(8) = "100100100" ' 8
strBarTable(9) = "010100100" ' 9
strBarTable(10) = "100010010" ' A
strBarTable(11) = "010010010" ' B
strBarTable(12) = "110000010" ' C
strBarTable(13) = "001010010" ' D
strBarTable(14) = "101000010" ' E
strBarTable(15) = "011000010" ' F
strBarTable(16) = "000110010" ' G
strBarTable(17) = "100100010" ' H
strBarTable(18) = "010100010" ' I
strBarTable(19) = "001100010" ' J
strBarTable(20) = "100010001" ' K
strBarTable(21) = "010010001" ' L
strBarTable(22) = "110000001" ' M
strBarTable(23) = "001010001" ' N
strBarTable(24) = "101000001" ' O
strBarTable(25) = "011000001" ' P
strBarTable(26) = "000110001" ' Q
strBarTable(27) = "100100001" ' R
strBarTable(28) = "010100001" ' S
strBarTable(29) = "001100001" ' T
strBarTable(30) = "100011000" ' U
strBarTable(31) = "010011000" ' V
strBarTable(32) = "110001000" ' W
strBarTable(33) = "001011000" ' X
strBarTable(34) = "101001000" ' Y
strBarTable(35) = "011001000" ' Z
strBarTable(36) = "000111000" ' -
strBarTable(37) = "100101000" ' %
strBarTable(38) = "010101000" ' $
strBarTable(39) = "001101000" ' *
If strBarCode = "" Then Exit Sub ' 不打印空串
' 保存打印机 ScaleMode
Dim intOldScaleMode As ScaleModeConstants
intOldScaleMode = Printer.ScaleMode
' 保存打印机 DrawWidth
Dim intOldDrawWidth As Integer
intOldDrawWidth = Printer.DrawWidth
' 保存打印机 Font
Dim fntOldFont As StdFont
Set fntOldFont = Printer.Font
Printer.ScaleMode = vbTwips ' 设置打印用的坐标刻度为缇(twip=1)
Printer.DrawWidth = 1 ' 线宽为 1
Printer.FontName = "宋体" ' 打印在条码下方字符的字体和大小
Printer.FontSize = 10
Dim strBC As String ' 要打印的条码字符串
strBC = UCase(strBarCode)
' 将以毫米表示的 X 坐标转换为以缇表示
Dim x As Integer
x = Printer.ScaleX(intXPos, vbMillimeters, vbTwips)
' 将以毫米表示的 Y 坐标转换为以缇表示
Dim y As Integer
y = Printer.ScaleY(intYPos, vbMillimeters, vbTwips)
' 将以毫米表示的高度转换为以缇表示
Dim intHeight As Integer
intHeight = Printer.ScaleY(intPrintHeight, vbMillimeters, vbTwips)
' 是否在条形码下方打印人工识别字符
If bolPrintText = True Then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -