📄 setp.frm
字号:
Height = 255
Index = 20
Left = 240
TabIndex = 21
Top = 6720
Width = 1095
End
Begin VB.Label Label1
Caption = "不确定度栏"
Height = 255
Index = 19
Left = 240
TabIndex = 20
Top = 6360
Width = 1095
End
Begin VB.Label Label1
Caption = "使用器具型号栏"
Height = 255
Index = 18
Left = 240
TabIndex = 19
Top = 6000
Width = 1335
End
Begin VB.Label Label1
Caption = "使用器具名称栏"
Height = 255
Index = 17
Left = 240
TabIndex = 18
Top = 5640
Width = 1335
End
Begin VB.Label Label1
Caption = "技术依据"
Height = 255
Index = 16
Left = 240
TabIndex = 17
Top = 5280
Width = 855
End
Begin VB.Label Label1
Caption = "有效期至"
Height = 255
Index = 15
Left = 240
TabIndex = 16
Top = 4920
Width = 855
End
Begin VB.Label Label1
Caption = "检定日期"
Height = 255
Index = 14
Left = 240
TabIndex = 15
Top = 4560
Width = 855
End
Begin VB.Label Label1
Caption = "检定员"
Height = 255
Index = 13
Left = 240
TabIndex = 14
Top = 4200
Width = 615
End
Begin VB.Label Label1
Caption = "检验员"
Height = 255
Index = 12
Left = 240
TabIndex = 13
Top = 3840
Width = 615
End
Begin VB.Label Label1
Caption = "室主任"
Height = 255
Index = 11
Left = 240
TabIndex = 12
Top = 3480
Width = 735
End
Begin VB.Label Label1
Caption = "检定结论"
Height = 255
Index = 10
Left = 240
TabIndex = 11
Top = 3120
Width = 855
End
Begin VB.Label Label1
Caption = "出厂编号"
Height = 255
Index = 9
Left = 240
TabIndex = 10
Top = 2760
Width = 855
End
Begin VB.Label Label1
Caption = "制造厂"
Height = 255
Index = 8
Left = 240
TabIndex = 9
Top = 2400
Width = 735
End
Begin VB.Label Label1
Caption = "型号规格"
Height = 255
Index = 7
Left = 240
TabIndex = 8
Top = 2040
Width = 855
End
Begin VB.Label Label1
Caption = "仪器名称"
Height = 255
Index = 6
Left = 240
TabIndex = 7
Top = 1680
Width = 855
End
Begin VB.Label Label1
Caption = "证书编号"
Height = 255
Index = 5
Left = 240
TabIndex = 6
Top = 960
Width = 855
End
Begin VB.Label Label1
Caption = "字段高"
Height = 255
Index = 4
Left = 5400
TabIndex = 5
Top = 720
Width = 855
End
Begin VB.Label Label1
Caption = "字段宽"
Height = 255
Index = 3
Left = 4200
TabIndex = 4
Top = 720
Width = 855
End
Begin VB.Label Label1
Caption = "Y坐标"
Height = 255
Index = 2
Left = 3000
TabIndex = 3
Top = 720
Width = 735
End
Begin VB.Label Label1
Caption = "X坐标"
Height = 255
Index = 1
Left = 1800
TabIndex = 2
Top = 720
Width = 495
End
Begin VB.Label Label1
Caption = "选择打印机"
Height = 255
Index = 0
Left = 240
TabIndex = 1
Top = 360
Width = 1095
End
End
End
Attribute VB_Name = "setp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim ci As Integer
Private Sub Combo1_Click()
strsql = "select * from dyjwz where dyjm='" & Combo1.Text & "'"
grs.Open strsql, conn, adOpenKeyset, adLockReadOnly, adCmdText
For i = 0 To 79
Text1(i) = grs.Fields(i + 1)
Next i
grs.Close
ci = Combo1.ListIndex
End Sub
Private Sub Command1_Click()
Combo1.Enabled = True
For i = 0 To 79
Text1(i).Enabled = True
Next i
Frame2.Visible = False
Frame3.Visible = True
prizj = 1
End Sub
Private Sub Command2_Click()
Combo1.Enabled = True
For i = 0 To 79
Text1(i).Enabled = True
Next i
Frame2.Visible = False
Frame3.Visible = True
prizj = 0
End Sub
Private Sub Command3_Click()
If Len(Combo1.Text) = 0 Then
an = MsgBox("请选择要删除打印机", vbYes, "提示!!!!!!!")
Else
an = MsgBox("你真的要删除打印机" + Combo1.Text + "吗?", vbYesNo, "提示!!!!!!!")
If an = 6 Then
strsql = "DELETE FROM dyjwz WHERE dyjm = '" & Combo1.Text & "'"
conn.BeginTrans
conn.Execute strsql
conn.CommitTrans
Combo1.RemoveItem ci
priset.Combo1.RemoveItem ci
End If
End If
End Sub
Private Sub Command4_Click()
'On Error GoTo err1
If prizj = 1 Then
If Len(Combo1.Text) <> 0 Then
sqlstr = adddate("dyjwz")
conn.Execute sqlstr
priset.Combo1.AddItem Combo1.Text
End If
For i = 0 To 79
Text1(i) = ""
Next i
Combo1.Text = ""
End If
If prizj = 0 Then
strsql = "update dyjwz set " & updates("dyjwz") & " where dyjm ='" & (Combo1.Text) & "'"
Debug.Print strsql
conn.Execute strsql
For i = 0 To 79
Text1(i) = ""
Next i
Combo1.Text = ""
End If
'err1:
End Sub
Private Sub Command5_Click()
Frame2.Visible = True
Frame3.Visible = False
For i = 0 To 79
Text1(i).Text = ""
Text1(i).Enabled = False
Next i
End Sub
Private Sub Command6_Click()
Unload Me
End Sub
Private Sub Form_Load()
Me.Move (main.Width - Me.Width) / 2, (main.Height - Me.Height) / 2
'Combo1.Enabled = False
For i = 0 To 79
Text1(i).Enabled = False
Next i
strsql = "select wz80,dyjm from dyjwz"
grs.Open strsql, conn, adOpenKeyset, adLockReadOnly, adCmdText
fillcombo Combo1, grs
grs.Close
End Sub
Function updates(tabn As String) As String 'tabn 表名
Dim fievar As ADODB.Field
Dim obj As Object
Dim tabna() As String
grs.Open tabn, conn, , , adCmdTable
fc = grs.Fields.Count
ReDim tabna(grs.Fields.Count)
i = 0
For Each fievar In grs.Fields
tabna(i) = fievar.Name
i = i + 1
Next fievar
grs.Close
i = fc - 1
strsql = ""
For Each obj In setp
If (left(obj.Name, 4) = "Text") Or (left(obj.Name, 5) = "Combo") Then
Debug.Print obj.Name
Debug.Print obj.Text
If i = fc - 1 Then
strsql = strsql & tabna(0) & " ='" & obj.Text & "',"
Else
strsql = strsql & tabna(i) & " =" & Val(obj.Text) & ","
End If
If i <> 0 Then
i = i - 1
End If
End If
Next obj
strsql = left(strsql, Len(strsql) - 1)
'Debug.Print strsql
updates = strsql
End Function
Function adddate(tabn As String) As String 'tabn 表名
Dim fievar As ADODB.Field
Dim obj As Object
Dim tabna() As String
grs.Open tabn, conn, , , adCmdTable
fc = grs.Fields.Count
ReDim tabna(grs.Fields.Count)
i = 0
For Each fievar In grs.Fields
tabna(i) = fievar.Name
i = i + 1
Next fievar
grs.Close
strsql1 = ""
strsql2 = ""
For Each obj In setp
If (left(obj.Name, 4) = "Text") Or (left(obj.Name, 5) = "Combo") Then
Debug.Print obj.Name
Debug.Print obj.Text
If left(obj.Name, 5) = "Combo" Then
aa = obj.Text
Else
strsql2 = strsql2 & "'" & Val(obj.Text) & " ',"
End If
strsql1 = strsql1 & tabna(i - 2) & ","
If i <> 0 Then
i = i - 1
End If
End If
Next obj
strsql1 = left(strsql1, Len(strsql1) - 1)
strsql2 = strsql2 + "'" + aa + "'"
adddate = "INSERT INTO " & tabn & " (" & strsql1 & ") values (" & strsql2 & ")"
Debug.Print adddate
End Function
Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 Then
If Index = 79 Then
Command5.SetFocus
Else
Text1(Index + 1).SetFocus
End If
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -