?? module1.bas
字號:
Attribute VB_Name = "Module1"
Global conn As ADODB.Connection
Global conns As String
Global grs As ADODB.Recordset
Global flag As Integer
Global bm(16) As String
Global bmm(4) As String
Type jlqj
mc As String
gg As String
dqd As String
jdzsh As String
End Type
Global jdjga(20) As String '檢定結果數組
Global jlqla(10) As jlqj '檢定器具數組
Global gzsbh As String '證書編號
Global gi As Integer '檢定器具數組i
Global gi2 As Integer
Global jlqjk As Integer '標志計量器具表是否為空
Global prizj '增加打印機標志
Global xgjg As Integer
Global xgjlqjfla As Integer
Global cxtj As String '查詢條件
Global btt(4) As Integer
Global jdzsnra(14) As String
Global jdtja(2) As Single
Type pritype
X As Single
Y As Single
l As Single
h As Single
End Type
Global pril(16) As pritype
Global pjlqj(4) As pritype
Global pjdjg As pritype
Global caxiun As Integer '查詢標記
Global caxunbj As Integer
'****************************************
Global btzsbh As String
Global btwtdw As String
Global btyqmc As String
Global btxhgg As String
Global btzzc As String
Global btccbh As String
Global btjdjl As String
Global btszr As String
Global btjyy As String
Global btjdy As String
Global btjdri As String
Global btyxqz As String
Global btjdyj As String
Public Sub fillcombo(ByVal cb As ComboBox, ByVal rs As ADODB.Recordset)
If rs.RecordCount > 0 Then
For i = 0 To rs.RecordCount - 1
If Len(rs.Fields(1)) <> 0 Then
cb.AddItem rs.Fields(1)
End If
rs.MoveNext
Next i
End If
End Sub
Public Sub fillmgz(ByVal grid As MSHFlexGrid, ByRef bm() As String, ByRef btl1() As Integer, ByVal rs1 As ADODB.Recordset)
'On Error GoTo err1:
'Debug.Print grid.Rows
'grid.RowHeight() = 0
For i = 2 To grid.Rows - 1
grid.RemoveItem 2
Next i
grid.Cols = rs1.Fields.Count
For i = 0 To rs1.Fields.Count - 1
grid.ColAlignment(i) = 1
grid.ColAlignmentFixed(i) = 1
If i = 13 Then
grid.ColWidth(i) = btl1(i) * 100
Else
grid.ColWidth(i) = btl1(i) * 200
End If
grid.TextMatrix(0, i) = bm(i)
Next i
For i = 0 To rs1.RecordCount - 1
strsql = ""
For j = 0 To rs1.Fields.Count - 1
strsql = strsql & rs1.Fields(j) & Chr(9)
Next j
rs1.MoveNext
grid.AddItem strsql
Next i
grid.RowHeight(1) = 0
err1:
rs1.Close
End Sub
Public Sub priint()
rx = 3000
rx1 = 4900
'1111111111111111111111
pril(0).X = 3700
pril(0).Y = 3500
pril(0).l = 0
pril(0).h = 0
'22222222222222222222222
pril(1).X = rx
pril(1).Y = 4200
pril(1).l = 0
pril(1).h = 0
'333333333333333333333333
pril(2).X = rx
pril(2).Y = 4650
pril(2).l = 0
pril(2).h = 0
'444444444444444444444444444
pril(3).X = rx
pril(3).Y = 5150
pril(3).l = 0
pril(3).h = 0
'55555555555555
pril(4).X = rx
pril(4).Y = 5600
pril(4).l = 0
pril(4).h = 0
'6
pril(5).X = rx
pril(5).Y = 6100
pril(5).l = 0
pril(5).h = 0
'7
pril(6).X = rx
pril(6).Y = 6550
pril(6).l = 0
pril(6).h = 0
'8
pril(7).X = rx1
pril(7).Y = 7900
pril(7).l = 0
pril(7).h = 0
'9
pril(8).X = rx1
pril(8).Y = 8300
pril(8).l = 0
pril(8).h = 0
'10
pril(9).X = rx1
pril(9).Y = 8800
pril(9).l = 0
pril(9).h = 0
'11
pril(10).X = rx
pril(10).Y = 9500
pril(10).l = 0
pril(10).h = 0
'12
pril(11).X = rx
pril(11).Y = 10000
pril(11).l = 0
pril(11).h = 0
End Sub
Public Sub prijdzs() '打印檢定證書正面
On Error GoTo err1
Printer.FontSize = 11
Printer.CurrentX = pril(i).X
Printer.CurrentY = pril(i).Y
Printer.Print jdzsnra(i)
For i = 1 To 9
If Len(jdzsnra(i)) > 15 Then
Printer.CurrentX = pril(i).X
Printer.CurrentY = pril(i).Y - Printer.TextHeight(jdzsnra(i))
Printer.Print Mid(jdzsnra(i), 1, 15)
Printer.CurrentY = pril(i).Y
Printer.CurrentX = pril(i).X
Printer.Print Mid(jdzsnra(i), 16, Len(jdzsnra(i)) - 15)
Else
Printer.CurrentX = pril(i).X
Printer.CurrentY = pril(i).Y
Printer.Print jdzsnra(i)
End If
Next i
Printer.CurrentX = pril(10).X + 400
Printer.CurrentY = pril(10).Y
dat = jdzsnra(10)
'dat = Format(dat, "yyyymmdd")
daty = Mid(dat, 1, 4)
Printer.Print daty
Printer.CurrentY = pril(10).Y
Printer.CurrentX = pril(10).X + 1850
datm = Mid(dat, 5, 2)
Printer.Print datm
Printer.CurrentY = pril(10).Y
Printer.CurrentX = pril(10).X + 3050
datd = Mid(dat, 7, 2)
Printer.Print datd
dat = jdzsnra(11)
'dat = Format(dat, "yyyymmdd")
Printer.CurrentX = pril(11).X + 400
Printer.CurrentY = pril(11).Y
Printer.Print Mid(dat, 1, 4)
Printer.CurrentY = pril(11).Y
Printer.CurrentX = pril(11).X + 1850
Printer.Print Mid(dat, 5, 2)
Debug.Print Mid(dat, 5, 2)
Printer.CurrentY = pril(11).Y
Printer.CurrentX = pril(11).X + 3050
Printer.Print Mid(dat, 7, 2)
Debug.Print Mid(dat, 7, 2)
Printer.EndDoc
err1:
If err.Number <> 0 Then
MsgBox err.Description, 4144, " 提示"
End If
End Sub
Public Sub intb()
pril(12).X = 1100
pril(12).Y = 2300
pril(12).l = 0
pril(12).h = 0
pril(13).X = 2700
pril(13).Y = 6330
pril(13).l = 0
pril(13).h = 0
pril(14).X = 5400
pril(14).Y = 6330
pril(14).l = 0
pril(14).h = 0
'Global pjlqj(4) As pritype
jlqjy = 3950
jlqjh = 1600
pjlqj(0).X = 750
pjlqj(0).Y = jlqjy
pjlqj(0).l = 1850
pjlqj(0).h = jlqjh
pjlqj(1).X = 2630
pjlqj(1).Y = jlqjy
pjlqj(1).l = 1500
pjlqj(1).h = jlqjh
pjlqj(2).X = 4200
pjlqj(2).Y = jlqjy
pjlqj(2).l = 1500
pjlqj(2).h = jlqjh
pjlqj(3).X = 5800
pjlqj(3).Y = jlqjy
pjlqj(3).l = 1600
pjlqj(3).h = jlqjh
'Global pjdjg As pritype
pjdjg.X = 1100
pjdjg.Y = 7500
pjdjg.h = 3000
pjdjg.l = 6800
End Sub
Public Sub pjdzsb() '打印檢定證書北面
'打印依據,溫度,濕度
On Error GoTo err1
Printer.FontSize = 11
Printer.CurrentX = pril(12).X
Printer.CurrentY = pril(12).Y
Printer.Print jdzsnra(12)
Printer.CurrentX = pril(13).X
Printer.CurrentY = pril(13).Y
Printer.Print jdzsnra(13)
Printer.CurrentX = pril(14).X
Printer.CurrentY = pril(14).Y
Printer.Print jdzsnra(14)
'打印器具表
i = 0
yy = pjlqj(0).Y
Do While Len(jlqla(i).mc) <> 0
For j = 0 To 3
If (yy < pjlqj(j).Y) Then
yy = pjlqj(j).Y
End If
Next j
For j = 0 To 3
pjlqj(j).Y = yy
Next j
pjlb pjlqj(0).X, pjlqj(0).Y, jlqla(i).mc, pjlqj(0).l, pjlqj(0).h
pjlb pjlqj(1).X, pjlqj(1).Y, jlqla(i).gg, pjlqj(1).l, pjlqj(1).h
pjlb pjlqj(2).X, pjlqj(2).Y, jlqla(i).dqd, pjlqj(2).l, pjlqj(2).h
pjlb pjlqj(3).X, pjlqj(3).Y, jlqla(i).jdzsh, pjlqj(3).l, pjlqj(3).h
i = i + 1
'an = MsgBox("名稱超過20個字", vbYes, "提示!!!!!!!")
Loop
'打印檢定結果
i = 0
ll = 0
Do While Len(jdjga(i)) <> 0
ll = ll + Printer.TextHeight(jdjga(i)) + 100
i = i + 1
Loop
If ll > pjdjg.h Then
an = MsgBox("內容太多", vbYesNo, "提示!!!!!!!")
End If
i = 0
Do While Len(jdjga(i)) <> 0
pjdj pjdjg.X, pjdjg.Y, pjdjg.l, pjdjg.h, jdjga(i)
pjdjg.Y = pjdjg.Y + Printer.TextHeight(jdjga(i)) + 100
i = i + 1
Loop
Printer.EndDoc
err1:
If err.Number <> 0 Then
MsgBox err.Description, 4144, " 提示"
End If
End Sub
Public Sub pjdj(x1 As Single, y1 As Single, ll As Single, hh As Single, str As String)
Dim ww As Single
Dim wh As Single
Printer.CurrentX = x1
Printer.CurrentY = y1
Printer.Print str
End Sub
Public Sub pjlb(ByVal X As Single, ByRef cy As Single, ByVal str As String, ByVal lw As Single, ByVal lh As Single)
Dim ww, wh As Single
Dim str1, str2 As String
Dim i, j, slen, ptr As Integer
ww = Printer.TextWidth(Trim(str))
wh = Printer.TextHeight(str)
If ww <= lw Then
Printer.CurrentX = X
Printer.CurrentY = cy
cy = cy + wh
Printer.Print str
Exit Sub
End If
slen = Len(Trim(str))
ptr = 1
j = 1
For i = 1 To slen
str1 = Mid(str, 1, j)
str2 = Mid(str, 1, j + 1)
If (Printer.TextWidth(str1)) <= lw And (Printer.TextWidth(str2) > lw) Or (j >= (slen - ptr + 1)) Then
Printer.CurrentX = X
Printer.CurrentY = cy
Printer.Print str1
ptr = ptr + Len(str1)
str = right(str, slen - ptr + 1)
j = 0
cy = cy + wh
End If
j = j + 1
Next i
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -