数据导入窗口.frm

光栅式指示表检定仪应用程序

      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
End
Attribute VB_Name = "数据导入窗口"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim fso As New FileSystemObject, fill As File, ts As TextStream, ts1 As TextStream
Dim tlen As Long
Dim s As String
Dim sa As String

Private Sub Command1_Click()
    CommonDialog1.CancelError = True
    On Error GoTo errhandler
    CommonDialog1.Filter = "All File(*.*)|*.*|Text_Files(*.txt)"
    CommonDialog1.FilterIndex = 2
    CommonDialog1.ShowOpen
    Command2.Enabled = True
    Command4.Enabled = True
    Command5.Enabled = True
    Command6.Enabled = True
    Set fill = fso.GetFile(CommonDialog1.FileName)
    Set ts = fill.OpenAsTextStream(ForReading)
    Set ts1 = fill.OpenAsTextStream(ForReading)
    s = ts.ReadLine
    s = s + ",#"
    Text1.Text = s
    sa = ts1.ReadAll
    tlen = Len(sa)
    Exit Sub
errhandler:
    Exit Sub
End Sub

Private Sub Command2_Click()
    Dim xlapp As Excel.Application
    Dim xlbook As Excel.Workbook
    Dim xlsheet1 As Excel.Worksheet
    Dim xlsheet2 As Excel.Worksheet
    Dim record(300) As String
    Dim rec1(120) As String
    Dim rec2(120) As String
    Dim s1 As String
    Dim s2 As String
    Dim s3 As String
    Dim no As String
    Dim i As Integer, j As Integer, k As Integer, sn As Integer, n As Integer
    Dim a As Integer, b As Integer, c As Integer
    i = 0
    Do While i < 300
        record(i) = ""
        i = i + 1
    Loop
    i = 0
    Do While i < 120
        rec1(i) = "/"
        rec2(i) = "/"
        i = i + 1
    Loop
    i = 1
    j = 0
    s1 = Mid(s, i, 1)
    s2 = ""
    Do While s1 <> "#"
        If s1 <> "," Then
            s2 = s2 + s1
        Else
            s2 = Trim(s2)
            record(j) = s2
            j = j + 1
            s2 = ""
        End If
        i = i + 1
        s1 = Mid(s, i, 1)
    Loop
    Select Case record(3)
        Case "(0 ～ 3)mm百分表"
            sn = 34
            n = 3
            c = 0
        Case "(0 ～ 5)mm百分表"
            sn = 34
            n = 5
            c = 0
        Case "(0 ～ 10)mm百分表"
            sn = 34
            n = 10
            c = 0
        Case "(0 ～ 20)mm百分表"
            sn = 32
            n = 4
            c = 1
        Case "(0 ～ 30)mm百分表"
            sn = 32
            n = 6
            c = 1
        Case "(0 ～ 50)mm百分表"
            sn = 32
            n = 10
            c = 2
        Case "(0 ～ 1)mm千分表"
            sn = 32
            n = 2
            c = 2
        Case "(0 ～ 2)mm千分表"
            sn = 32
            n = 4
            c = 2
        Case "(0 ～ 3)mm千分表"
            sn = 32
            n = 6
            c = 2
        Case "(0 ～ 5)mm千分表"
            sn = 32
            n = 5
            c = 2
    End Select
    i = sn
    j = n
    k = 0
    Do While j > 0
        rec1(k) = record(i)
        k = k + 1
        If ((i - sn) Mod 10 = 0) And (i <> sn) Then
            j = j - 1
            If j <> 0 Then
                rec1(k) = record(i)
                k = k + 1
            End If
        End If
        i = i + 1
    Loop
    sn = i
    j = n
    k = 0
    Do While j > 0
        rec2(k) = record(i)
        k = k + 1
        If ((i - sn) Mod 10 = 0) And (i <> sn) Then
            j = j - 1
            If j <> 0 Then
                rec2(k) = record(i)
                k = k + 1
            End If
        End If
        i = i + 1
    Loop
    
    Adodc1.Recordset.MoveLast
    s3 = Adodc1.Recordset.Fields(0)
    s1 = Mid(s3, 1, 4)
    s2 = Mid(s3, 5, 8)
    s2 = Val(s2) + 1
    s3 = Trim(s1) & Trim(Str$(s2))
    no = Trim(s3)
    Adodc1.Recordset.Fields(0) = s3
    Adodc1.Recordset.Update
    
    Set xlapp = CreateObject("excel.application")
    Set xlbook = xlapp.Workbooks.Add
    Set fil1 = fso.GetFile(App.Path & "\model\JDY.xls")
    fil1.Copy (App.Path & "\打印文件\" & no & ".xls")
    Set xlbook = Workbooks.Open(App.Path & "\打印文件\" & no & ".xls")
    Set xlsheet1 = xlbook.Worksheets(1)
    Set xlsheet2 = xlbook.Worksheets(2)
    i = 0
    j = 0
    Do While j < 10
        a = 15 + j * 2
        b = 16 + j * 2
        xlsheet1.Range("c" & Trim(Str$(a))) = rec1(i)
        xlsheet1.Range("c" & Trim(Str$(b))) = rec2(i)
        i = i + 1
        xlsheet1.Range("D" & Trim(Str$(a))) = rec1(i)
        xlsheet1.Range("D" & Trim(Str$(b))) = rec2(i)
        i = i + 1
        xlsheet1.Range("E" & Trim(Str$(a))) = rec1(i)
        xlsheet1.Range("E" & Trim(Str$(b))) = rec2(i)
        i = i + 1
        xlsheet1.Range("F" & Trim(Str$(a))) = rec1(i)
        xlsheet1.Range("F" & Trim(Str$(b))) = rec2(i)
        i = i + 1
        xlsheet1.Range("G" & Trim(Str$(a))) = rec1(i)
        xlsheet1.Range("G" & Trim(Str$(b))) = rec2(i)
        i = i + 1
        xlsheet1.Range("H" & Trim(Str$(a))) = rec1(i)
        xlsheet1.Range("H" & Trim(Str$(b))) = rec2(i)
        i = i + 1
        xlsheet1.Range("I" & Trim(Str$(a))) = rec1(i)
        xlsheet1.Range("I" & Trim(Str$(b))) = rec2(i)
        i = i + 1
        xlsheet1.Range("J" & Trim(Str$(a))) = rec1(i)
        xlsheet1.Range("J" & Trim(Str$(b))) = rec2(i)
        i = i + 1
        xlsheet1.Range("K" & Trim(Str$(a))) = rec1(i)
        xlsheet1.Range("K" & Trim(Str$(b))) = rec2(i)
        i = i + 1
        xlsheet1.Range("L" & Trim(Str$(a))) = rec1(i)
        xlsheet1.Range("L" & Trim(Str$(b))) = rec2(i)
        i = i + 1
        xlsheet1.Range("M" & Trim(Str$(a))) = rec1(i)
        xlsheet1.Range("M" & Trim(Str$(b))) = rec2(i)
        i = i + 1
        If i Mod 11 = 0 Then
            j = j + 1
        End If
    Loop
    xlsheet1.Range("c3") = record(5)
    xlsheet1.Range("i3") = Left(Trim(record(11)), Len(Trim(record(11))) - 2)
    If c = 0 Or c = 1 Then
        xlsheet1.Range("o3") = "0.01"
    ElseIf c = 2 Then
        xlsheet1.Range("o3") = "0.001"
    End If
    xlsheet1.Range("q3") = record(14) & "℃"
    xlsheet1.Range("c4") = Right(Trim(record(3)), 3)
    xlsheet1.Range("i4") = record(4)
    xlsheet1.Range("o4") = record(2)
    xlsheet1.Range("q4") = record(13) & "%"
    xlsheet1.Range("p35") = record(16)
    If c = 0 Then
        xlsheet1.Range("n15") = record(31) & "μm(" & record(30) & "mm段)"
        xlsheet1.Range("o15") = record(33) & "μm(" & record(32) & "mm处)"
        xlsheet1.Range("p15") = record(27) & "μm"
        xlsheet1.Range("q15") = record(29) & "μm(" & record(28) & "mm处)"
    ElseIf c = 1 Or c = 2 Then
        xlsheet1.Range("n15") = record(31) & "μm(" & record(30) & "mm段)"
        xlsheet1.Range("p15") = record(27) & "μm"
        xlsheet1.Range("q15") = record(29) & "μm(" & record(28) & "mm处)"
    End If
    ''Adodc1.Recordset.Open
    'Adodc1.Recordset.MoveLast
    's3 = Adodc1.Recordset.Fields(0)
    's1 = Mid(s3, 1, 4)
    's2 = Mid(s3, 5, 8)
    's2 = Val(s2) + 1
    's3 = Trim(s1) & Trim(Str$(s2))
    'Adodc1.Recordset.Fields(0) = s3
    'Adodc1.Recordset.Update
    'Adodc1.Recordset.Close
    xlsheet2.Range("d6") = s3 ' 证书编号：
    xlsheet2.Range("d8") = record(5) '   委托方
    xlsheet2.Range("d9") = record(3) '   计量器具名称
    xlsheet2.Range("d10") = record(11) '   型   号  规   格
    xlsheet2.Range("d11") = record(4) '   制      造      厂
    xlsheet2.Range("d12") = record(2) '   出   厂  编   号
    xlsheet2.Range("d13") = "------" '   器   具   编   号
    xlsheet2.Range("d14") = record(16) '   结                论
    xlsheet2.Range("c20") = record(10) '检定日期
    s1 = Left$(Trim(record(10)), 5)
    i = Val(s1)
    s2 = Mid$(Trim(record(10)), 6, Len(Trim(record(10))) - 8)
    j = Val(s2)
    s3 = Right$(Trim(record(10)), 3)
    k = Val(s3)
    i = i + 1
    k = k - 1
    If k = 0 Then
        j = j - 1
        If j = 0 Then
            i = i - 1
            j = 12
            k = 30
        Else
            Select Case j
                Case 1, 3, 5, 7, 8, 10, 12
                    k = 31
                Case 2
                    If (i Mod 100 = 0 And i Mod 400 = 0) Or (i Mod 100 <> 0 And i Mod 4 = 0) Then
                        k = 29
                    Else
                        k = 28
                    End If
                Case 4, 6, 9, 11
                    k = 30
            End Select
        End If
    End If
    xlsheet2.Range("c21") = Trim(Str$(i)) & Trim("年") & Trim(Str$(j)) & Trim("月") & Trim(Str$(k)) & Trim("日") '检定日期
    xlbook.Save
    xlbook.Close
    Workbooks.Close
    aa = Shell("d:\Office10\excel.exe " & App.Path & "\打印文件\" & no & ".xls" & " ", vbNormalFocus)
    
    
End Sub

Private Sub Command3_Click()
    End
End Sub

Private Sub Command4_Click()
    tlen = tlen - Len(s)
    If tlen <> 0 Then
        s = ts.ReadLine + ",#"
        Text1.Text = s
    Else
        Command4.Enabled = False
    End If
End Sub

Private Sub Command5_Click()
    Set fill = fso.GetFile(CommonDialog1.FileName)
    Set ts = fill.OpenAsTextStream(ForReading)
    Set ts1 = fill.OpenAsTextStream(ForReading)
    s = ts.ReadLine
    s = s + ",#"
    Text1.Text = s
    sa = ts1.ReadAll
    tlen = Len(sa)
    Command4.Enabled = True
End Sub

Private Sub Command6_Click()
    ts.Close
    ts1.Close
    Text1.Text = ""
    Command2.Enabled = False
    Command4.Enabled = False
    Command5.Enabled = False
End Sub

Private Sub Command7_Click()
    Dim s1 As String
    Dim s2 As String
    Dim s3 As String
    s3 = Text2.Text
    If Len(Trim(s3)) = 12 Then
        Adodc1.Recordset.MoveLast
        s1 = Mid(s3, 1, 4)
        s2 = Mid(s3, 5, 8)
        s2 = Val(s2) - 1
        s3 = Trim(s1) & Trim(Str$(s2))
        Adodc1.Recordset.Fields(0) = s3
        Adodc1.Recordset.Update
        MsgBox "恭喜您，您的证书编号修改操作成功!", vbExclamation + vbOKOnly, "修改成功"
    Else
        MsgBox "证书编号输入错误，请重新输入!", vbExclamation + vbOKOnly, "提示"
    End If
End Sub

Private Sub Command8_Click()
    Unload Me
    登录窗口.Show
    登录窗口.Text2.Text = ""
    登录窗口.Text3.Text = ""
End Sub

Private Sub Command9_Click()
    Dim aa As String
    aa = Shell("d:\检定仪27N\jdy27.exe " & " ", vbNormalFocus)
End Sub

Private Sub Form_Load()
    Adodc1.Refresh
    数据导入窗口.Height = 6800
    Frame3.Height = 2399.675
    Command2.Enabled = False
    Command4.Enabled = False
    Command5.Enabled = False
    Command6.Enabled = False
    'If Adodc2.Recordset.Fields(0) = 1 Then
    If user = 1 Then
        Frame3.Enabled = True
        Text2.Enabled = True
        Label1.Enabled = True
        Label2.Enabled = False
        Label2.Visible = False
        Command7.Enabled = True
        数据导入窗口.Height = 6300
        Frame3.Height = 1600
    'ElseIf Adodc2.Recordset.Fields(0) = 2 Then
    Else
        Frame3.Enabled = False
        Text2.Enabled = False
        Label1.Enabled = False
        Label2.Enabled = True
        Label2.Visible = True
        Command7.Enabled = False
    End If
End Sub