vb82.tmp

一个关于进销存的源代码

             MsgBox "数据不存在,无法删除", vbOKOnly, "数据删除操作"
          Else
             Dim rdst As New ADODB.Recordset
             rdst.Open "select * from ncjmrkdcb where 村 = '" & Text4.Text & "'and 序号 = '" & Text5.Text & "'", g_conn
               If rdst.EOF = False Then
               Set rdst = Nothing
               rdst.Open "delete * from ncjmrkdcb where 村 = '" & Text4.Text & "'and 序号 = '" & Text5.Text & "'", g_conn
               MsgBox "数据删除成功", vbOKOnly, "数据删除操作"
            Else
               MsgBox "数据不存在,无法删除", vbOKOnly, "数据删除操作"
               End If
          End If
    End If
End Sub
Private Sub Command4_Click()
    '数据修改
Dim ts As String
ts = MsgBox("是否确定更新?", vbOKCancel, "更新操作")
If ts = vbOK Then
    Dim rdst As New ADODB.Recordset
    'rdst.Open "update ncjmrkdcb set 水田 = " & Text6.Text & " where 序号 = '" & Text5.Text & "'", g_conn
    rdst.Open "select * from ncjmrkdcb where 村 = '" & Text4.Text & "'and 序号 = '" & Text5.Text & "'", g_conn
       If rdst.EOF = True Then
            MsgBox "更新失败，数据不存在", vbOKOnly, "数据更新操作"
       Else
           Set rdst = Nothing
           rdst.Open "delete * from ncjmrkdcb where 村 = '" & Text4.Text & "'and 序号 = '" & Text5.Text & "'", g_conn
           Set rdst = Nothing
           Call Command10_Click
           MsgBox "更新成功", vbOKOnly, "数据更新操作"
       End If
End If
End Sub
Private Sub Command5_Click()
   ' On Error Resume Next
        If Text5.Text = "" Then
            Text9.Text = "统计信息"
            Text40.Text = "统计信息"
            Text41.Text = "统计信息"
            Text42.Text = "统计信息"
            Text43.Text = "统计信息"
            Text44.Text = "统计信息"
            Text45.Text = "统计信息"
            Text46.Text = "统计信息"
            Text47.Text = "统计信息"
            Text48.Text = "统计信息"
      End If
         
         If Text46.Text = "" Then Text46.Text = "0"
     
     If Dir(App.Path & "\统计表\南水北调表格2-2.xls") <> "" Then
       Dim fso, f1, f2, f3
       Set fso = CreateObject("Scripting.FileSystemObject")
        If Dir(App.Path & "\南水北调表格2-2.xls") <> "" Then
          Kill App.Path & "\南水北调表格2-2.xls"
          End If
       fso.copyfile App.Path & "\统计表\南水北调表格2-2.xls", App.Path & "\南水北调表格2-2.xls"
       xls_conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & App.Path & "\南水北调表格2-2.xls"
       Dim rdst As New ADODB.Recordset
          rdst.Open "insert into [a$] values('" & Text1.Text & "','" & Text2.Text & "','" & Text3.Text & "','" & Text4.Text & "','" & Text5.Text & "','" & Text6.Text _
            & "'," & Val(Text7.Text) & "," & Val(Text8.Text) & ",'" & Text9.Text & "'," & Val(Text10.Text) & "," & Val(Text11.Text) & "," & Val(Text12.Text) & "," & Val(Text13.Text) _
            & "," & Val(Text14.Text) & "," & Val(Text15.Text) & "," & Val(Text16.Text) & "," & Val(Text17.Text) & "," & Val(Text18.Text) & "," & Val(Text19.Text) & "," & Val(Text20.Text) _
            & ",'" & Val(Text21.Text) & "'," & Val(Text22.Text) & "," & Val(Text23.Text) & "," & Val(Text24.Text) & "," & Val(Text25.Text) & "," & Val(Text26.Text) & "," & Val(Text27.Text) _
            & "," & Val(Text28.Text) & "," & Val(Text29.Text) & ",'" & Text30.Text & "'," & Val(Text31.Text) & "," & Val(Text32.Text) & "," & Val(Text33.Text) & "," & Val(Text34.Text) & "," & Val(Text35.Text) _
            & "," & Val(Text36.Text) & "," & Val(Text37.Text) & "," & Val(Text38.Text) & "," & Val(Text39.Text) & ",'" & Text40.Text & "','" & Text41.Text & "','" & Text42.Text & "','" & Text43.Text _
            & "','" & Text44.Text & "','" & Text45.Text & "','" & Text46.Text & "','" & Text47.Text & "','" & Text48.Text & "')", xls_conn
       
        If tongji <> "" Then
                    Dim ts As String
                    ts = MsgBox("是否输出所有查询对象?", vbOKCancel, "数据输出")
                      If ts = vbOK Then
                          Dim rdst2 As New ADODB.Recordset
                              rdst2.Open tongji, g_conn
                              Dim mdbvalue As String
                                 Dim i As Integer
                                 Do While Not rdst2.EOF
                                     For i = 1 To rdst2.Fields.Count
                                        mdbvalue = mdbvalue & "'" & rdst2.Fields(i - 1).Value & "'" & ","
                                     Next i
                                     Debug.Print Left(mdbvalue, Len(mdbvalue) - 1)
                                   rdst.Open "insert into [a$] values(" & Left(mdbvalue, Len(mdbvalue) - 1) & ")", xls_conn
                                     mdbvalue = ""
                                 rdst2.MoveNext
                                 Loop
                      End If
         End If
              xls_conn.Close
              xlsopen (App.Path & "\南水北调表格2-2.xls")
         Else
         MsgBox "输出*.xls文件错误", vbOKCancel, "模版表不存在"
         Exit Sub
   End If
      ' 把输出的excel表打开
      ' xlsopen (App.Path & "\南水北调表格2-2.xls")
      ' xls_conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & App.Path & "\南水北调表格2-2.xls"
End Sub
Private Sub Command6_Click()
'调查表浏览
    If Right((UCase(Text40.Text)), 3) = "JPG" And Len(Text40.Text) > 14 Then
       dcbll (Text40.Text)
    Else
       MsgBox "调查表扫描件不存在", vbOKOnly, "浏览文件信息"
    End If
End Sub
Private Sub Command7_Click()
'相片浏览
    If Right((UCase(Text41.Text)), 3) = "JPG" And Len(Text41.Text) > 14 Then
       zpll (Text41.Text)
    Else
       MsgBox "照片信息不存在", vbOKOnly, "浏览文件信息"
    End If
End Sub
Private Sub Command8_Click()
'宗地图浏览
        If Right((UCase(Text42.Text)), 3) = "DWG" And Len(Text42.Text) > 14 Then
           zdtll (Text42.Text)
        Else
           MsgBox "宗地图信息不存在", vbOKOnly, "浏览文件信息"
        End If
End Sub
Private Sub Command9_Click()
        Unload Me
End Sub
Private Sub Form_Load()
        askn.ApplySkin Me.hWnd
'load时候显示第一条记录
'如果无记录则..
On Error Resume Next
      tongji = ""
        Me.Left = dhfrm.Width + 20
        Me.Top = 0
        Me.Height = 10455 - 350
        Me.Width = MDIForm1.Width - Me.Left - 60
    Dim rdst As New ADODB.Recordset
    rdst.Open "select * from ncjmrkdcb order by 户主 asc", g_conn
        Text1.Text = rdst.Fields(0).Value
        Text2.Text = rdst.Fields(1).Value
        Text3.Text = rdst.Fields(2).Value
        Text4.Text = rdst.Fields(3).Value
        Text5.Text = rdst.Fields(4).Value
        Text6.Text = rdst.Fields(5).Value
        Text7.Text = rdst.Fields(6).Value & "人"
        Text8.Text = rdst.Fields(7).Value & "人"
        Text9.Text = rdst.Fields(8).Value
        Text10.Text = rdst.Fields(9).Value & "平方米"
        Text11.Text = rdst.Fields(10).Value & "平方米"
        Text12.Text = rdst.Fields(11).Value & "平方米"
        Text13.Text = rdst.Fields(12).Value & "平方米"
        Text14.Text = rdst.Fields(13).Value & "平方米"
        Text15.Text = rdst.Fields(14).Value & "平方米"
        Text16.Text = rdst.Fields(15).Value & "平方米"
        Text17.Text = rdst.Fields(16).Value & "平方米"
        Text18.Text = rdst.Fields(17).Value & "平方米"
        Text19.Text = rdst.Fields(18).Value & "平方米"
        Text20.Text = rdst.Fields(19).Value & "平方米"
        
        Text21.Text = rdst.Fields(20).Value & "个"
        Text22.Text = rdst.Fields(21).Value & "平方米"
        Text23.Text = rdst.Fields(22).Value & "平方米"
        Text24.Text = rdst.Fields(23).Value & "个"
        Text25.Text = rdst.Fields(24).Value & "个"
        Text26.Text = rdst.Fields(25).Value & "立方米"
        Text27.Text = rdst.Fields(26).Value & "眼"
        Text28.Text = rdst.Fields(27).Value & "眼"
        Text29.Text = rdst.Fields(28).Value & "个"
        Text30.Text = rdst.Fields(29).Value
        Text31.Text = rdst.Fields(30).Value & "台"
        Text32.Text = rdst.Fields(31).Value & "部"
        Text33.Text = rdst.Fields(32).Value & "台"
        Text34.Text = rdst.Fields(33).Value & "棵"
        Text35.Text = rdst.Fields(34).Value & "棵"
        Text36.Text = rdst.Fields(35).Value & "棵"
        Text37.Text = rdst.Fields(36).Value & "棵"
        Text38.Text = rdst.Fields(37).Value & "棵"
        Text39.Text = rdst.Fields(38).Value & "棵"
        Text40.Text = rdst.Fields(39).Value
        Text41.Text = rdst.Fields(40).Value
        Text42.Text = rdst.Fields(41).Value
        Text43.Text = rdst.Fields(42).Value
        Text44.Text = rdst.Fields(43).Value
        Text45.Text = rdst.Fields(44).Value
        Text46.Text = mlchr(rdst.Fields(45).Value, 30)
        Text47.Text = rdst.Fields(46).Value
        Text48.Text = rdst.Fields(47).Value
        Set rdst = Nothing
        Command10.Visible = False
End Sub
Sub tjinfo(jiansuo As String, shi As String, qu As String, banshichu As String, cun As String, i As Integer)
        lvhuadai = 0
        kongguiqu = 0
    '调入统计信息,清空各text
        Text1.Text = ""
        Text2.Text = ""
        Text3.Text = ""
        Text4.Text = ""
        Text5.Text = ""
        Text6.Text = ""
        Text7.Text = ""
        Text8.Text = ""
        Text9.Text = ""
        Text10.Text = ""
        Text11.Text = ""
        Text12.Text = ""
        Text13.Text = ""
        Text14.Text = ""
        Text15.Text = ""
        Text16.Text = ""
        Text17.Text = ""
        Text18.Text = ""
        Text19.Text = ""
        Text20.Text = ""
        Text21.Text = ""
        Text22.Text = ""
        Text23.Text = ""
        Text24.Text = ""
        Text25.Text = ""
        Text26.Text = ""
        Text27.Text = ""
        Text28.Text = ""
        Text29.Text = ""
        Text30.Text = ""
        Text31.Text = ""
        Text32.Text = ""
        Text33.Text = ""
        Text34.Text = ""
        Text35.Text = ""
        Text36.Text = ""
        Text37.Text = ""
        Text38.Text = ""
        Text39.Text = ""
        Text40.Text = ""
        Text41.Text = ""
        Text42.Text = ""
        Text43.Text = ""
        Text44.Text = ""
        Text45.Text = ""
        Text46.Text = ""
        Text47.Text = ""
        Text48.Text = ""
        
        Text1.Text = shi
        Text2.Text = qu
        Text3.Text = banshichu
    
    Dim rdst As New ADODB.Recordset
        rdst.Open jiansuo, g_conn
        Dim tv As Integer
        tv = 0
        '累加统计
    Do While Not rdst.EOF
        Text4.Text = Text4.Text & rdst.Fields(5).Value & "、"
        Text5.Text = "统计信息"
        Text6.Text = "统计信息"
        Text7.Text = Val(Text7.Text) + Val(rdst.Fields(6).Value) & "人"
        Text8.Text = Val(Text8.Text) + Val(rdst.Fields(7).Value) & "人"
        Text9.Text = "统计信息"
        Text10.Text = Val(Text10.Text) + Val(rdst.Fields(9).Value) & "平方米"
        Text11.Text = Val(Text11.Text) + Val(rdst.Fields(10).Value) & "平方米"
        Text12.Text = Val(Text12.Text) + Val(rdst.Fields(11).Value) & "平方米"
        Text13.Text = Val(Text13.Text) + Val(rdst.Fields(12).Value) & "平方米"
        Text14.Text = Val(Text14.Text) + Val(rdst.Fields(13).Value) & "平方米"
        Text15.Text = Val(Text15.Text) + Val(rdst.Fields(14).Value) & "平方米"
        Text16.Text = Val(Text16.Text) + Val(rdst.Fields(15).Value) & "平方米"
        Text17.Text = Val(Text17.Text) + Val(rdst.Fields(16).Value) & "平方米"
        Text18.Text = Val(Text18.Text) + Val(rdst.Fields(17).Value) & "平方米"
        '附属设施
        Text19.Text = Val(Text19.Text) + Val(rdst.Fields(18).Value) & "平方米"
        Text20.Text = Val(Text20.Text) + Val(rdst.Fields(19).Value) & "平方米"
        Text21.Text = Val(Text21.Text) + Val(rdst.Fields(20).Value) & "个"
        
        Text22.Text = Val(Text22.Text) + Val(rdst.Fields(21).Value) & "平方米"
        Text23.Text = Val(Text23.Text) + Val(rdst.Fields(22).Value) & "平方米"
        Text24.Text = Val(Text24.Text) + Val(rdst.Fields(23).Value) & "个"
        Text25.Text = Val(Text25.Text) + Val(rdst.Fields(24).Value) & "个"
        Text26.Text = Val(Text26.Text) + Val(rdst.Fields(25).Value) & "立方米"
        Text27.Text = Val(Text27.Text) + Val(rdst.Fields(26).Value) & "眼"
        Text28.Text = Val(Text28.Text) + Val(rdst.Fields(27).Value) & "眼"
        Text29.Text = Val(Text29.Text) + Val(rdst.Fields(28).Value) & "个"
        
           If rdst.Fields(29).Value = "有" Then tv = tv + 1
        Text30.Text = "有" & tv & "个"
        Text31.Text = Val(Text31.Text) + Val(rdst.Fields(30).Value) & "台"
        Text32.Text = Val(Text32.Text) + Val(rdst.Fields(31).Value) & "部"
        Text33.Text = Val(Text33.Text) + Val(rdst.Fields(32).Value) & "台"
        Text34.Text = Val(Text34.Text) + Val(rdst.Fields(33).Value) & "棵"
        Text35.Text = Val(Text35.Text) + Val(rdst.Fields(34).Value) & "棵"
        Text36.Text = Val(Text36.Text) + Val(rdst.Fields(35).Value) & "棵"
        Text37.Text = Val(Text37.Text) + Val(rdst.Fields(36).Value) & "棵"
        Text38.Text = Val(Text38.Text) + Val(rdst.Fields(37).Value) & "棵"
        Text39.Text = Val(Text39.Text) + Val(rdst.Fields(38).Value) & "棵"
        Text40.Text = "统计信息"
        Text41.Text = "统计信息"
        Text42.Text = "统计信息"
        
        If rdst.Fields(42).Value <> "0" Then
            Text43.Text = Text43.Text & rdst.Fields(42).Value
        End If
        If rdst.Fields(43).Value <> "0" Then
            Text44.Text = Text44.Text & rdst.Fields(43).Value
        End If
        If rdst.Fields(44).Value <> "0" Then
            Text45.Text = Text45.Text & rdst.Fields(44).Value
        End If
        
        If rdst.Fields(46).Value = "绿化带" Then
            lvhuadai = lvhuadai + 1
        ElseIf rdst.Fields(46).Value = "控规区" Then
            kongguiqu = kongguiqu + 1
        Else
            MsgBox "未表明所属区域", vbOKOnly, "区域未标明"
        End If
        If rdst.Fields(47).Value <> "0" Then
            Text48.Text = Text48.Text & rdst.Fields(47).Value
        End If
        rdst.MoveNext
    Loop
        Text43.Text = Len(Text43.Text) & "户财产房"
        Text44.Text = Len(Text44.Text) & "户公有房"
        Text45.Text = Len(Text45.Text) & "户副业房"
        Text47.Text = lvhuadai & "户在绿化带" & "," & kongguiqu & "户在控规区"
        Text48.Text = Len(Text48.Text) & "户未签字"
        '统计信息
        Text46.Text = "统计了" & i & "户"
        Text4.Text = cun
End Sub
Sub info(fid As String, hzname As String)
   '单个显示
   'Debug.Print xuhao
    Dim rdst As New ADODB.Recordset
        rdst.Open "select * from ncjmrkdcb where 序号 = '" & fid & "'and 户主='" & hzname & "'", g_conn
    Do While Not rdst.EOF
        Text1.Text = rdst.Fields(0).Value
        Text2.Text = rdst.Fields(1).Value
        Text3.Text = rdst.Fields(2).Value
        Text4.Text = rdst.Fields(3).Value
        Text5.Text = rdst.Fields(4).Value
        Text6.Text = rdst.Fields(5).Value
        Text7.Text = rdst.Fields(6).Value & "人"
        Text8.Text = rdst.Fields(7).Value & "人"
        Text9.Text = rdst.Fields(8).Value
        Text10.Text = rdst.Fields(9).Value & "平方米"
        Text11.Text = rdst.Fields(10).Value & "平方米"
        Text12.Text = rdst.Fields(11).Value & "平方米"
        Text13.Text = rdst.Fields(12).Value & "平方米"
        Text14.Text = rdst.Fields(13).Value & "平方米"
        Text15.Text = rdst.Fields(14).Value & "平方米"
        Text16.Text = rdst.Fields(15).Value & "平方米"
        Text17.Text = rdst.Fields(16).Value & "平方米"
        Text18.Text = rdst.Fields(17).Value & "平方米"
        Text19.Text = rdst.Fields(18).Value & "平方米"
        Text20.Text = rdst.Fields(19).Value & "平方米"
        
        Text21.Text = rdst.Fields(20).Value & "个"
        Text22.Text = rdst.Fields(21).Value & "平方米"
        Text23.Text = rdst.Fields(22).Value & "平方米"
        Text24.Text = rdst.Fields(23).Value & "个"
        Text25.Text = rdst.Fields(24).Value & "个"
        Text26.Text = rdst.Fields(25).Value & "立方米"
        Text27.Text = rdst.Fields(26).Value & "眼"
        
        Text28.Text = rdst.Fields(27).Value & "眼"
        Text29.Text = rdst.Fields(28).Value & "个"
        Text30.Text = rdst.Fields(29).Value
        Text31.Text = rdst.Fields(30).Value & "台"
        Text32.Text = rdst.Fields(31).Value & "部"
        Text33.Text = rdst.Fields(32).Value & "台"
        Text34.Text = rdst.Fields(33).Value & "棵"
        Text35.Text = rdst.Fields(34).Value & "棵"
        Text36.Text = rdst.Fields(35).Value & "棵"
        Text37.Text = rdst.Fields(36).Value & "棵"
        Text38.Text = rdst.Fields(37).Value & "棵"
        Text39.Text = rdst.Fields(38).Value & "棵"
        Text40.Text = rdst.Fields(39).Value
        Text41.Text = rdst.Fields(40).Value
        Text42.Text = rdst.Fields(41).Value
        Text43.Text = rdst.Fields(42).Value
        Text44.Text = rdst.Fields(43).Value
        Text45.Text = rdst.Fields(44).Value
        Text46.Text = mlchr(rdst.Fields(45).Value, 30)
        Text47.Text = rdst.Fields(46).Value
        Text48.Text = rdst.Fields(47).Value
    rdst.MoveNext
    Loop
End Sub
Private Sub Form_Unload(Cancel As Integer)
        tjnum = 0
        tongji = ""
        tiaojian = ""
        tiaojian2 = ""
End Sub