frminvest.frm

用于三次采油技术的经济评价

  ' .OpenRecordset
      .Update
      If (.EOF = True) And (.BOF = True) Then
         'MsgBox "数据库无记录"
       .MoveLast
      
      Else
        .MoveFirst
         Do While .EOF = False
           Count = Count + 1
           .MoveNext
         Loop
       'MsgBox "数据库共有" & Count & "条记录"
     End If
     
   End With
   VarPingJiaQi = Count
    TxtNianXian.Text = Str(Count)
   'Data1.Refresh
   adozjyyyhg.MoveFirst
   
   For i = 1 To Count
       'FrmTouZi.MSFlexGrid1.TextArray(2 * I + 1) = form1.data1.Recordset.Fields(1).Value
       VarTouZi(i) = adozjyyyhg.Fields(1).Value
       varzchbl(i) = adozjyyyhg.Fields(2).Value
       varzchnl(i) = adozjyyyhg.Fields(3).Value
       
       VarLiuDongZiJin(i) = adozjyyyhg.Fields(4).Value
        vardkbl(i) = adozjyyyhg.Fields(5).Value
         vardknl(i) = adozjyyyhg.Fields(6).Value


      ' MsgBox VarLiuDongZiJin(I)
       adozjyyyhg.MoveNext
  Next i
  adozjyyyhg.Close
   
  
  
myerrr:
MousePointer = 0
   Me.Enabled = -1
       Me.MousePointer = 1
  
End Sub

Private Sub ins_line_Click()
  MSFlexGrid1.Text = Text1.Text
  Beep
4 msg$ = "注意：输入增加行数应在1～" & Trim$(Str$(insline_max)) & "之间！" + Chr$(13) + Chr$(10) + Chr$(13) + Chr$(10) + "请输入增加行数："
  wgxx$ = InputBox$(msg$, "信息输入")
  If wgxx$ = "" Then Exit Sub
  AddLine = Int(Val(Trim$(wgxx$)))
  If AddLine < 1 Or AddLine > insline_max Then
   Beep
   msg$ = "输入信息错误。" + Chr$(13) + Chr$(10) + Chr$(13) + Chr$(10) + "输入增加行数应在1～" & Trim$(Str$(insline_max)) & "之间。"
   Title$ = "警告"
   xchoose = MsgBox(msg$, 48, Title$)
   GoTo 4
  End If
  
  For i = MSFlexGrid1.Rows - 1 To MSFlexGrid1.row + AddLine Step -1
   For k = 1 To MSFlexGrid1.Cols - 1
    MSFlexGrid1.TextMatrix(i, k) = MSFlexGrid1.TextMatrix(i - AddLine, k)
   Next k
  Next i
  For i = MSFlexGrid1.row To MSFlexGrid1.row + AddLine - 1
   For k = 1 To MSFlexGrid1.Cols - 1
    MSFlexGrid1.TextMatrix(i, k) = ""
   Next k
  Next i
    
  Call blank_MSFlexGridshow
  
  MSFlexGrid1.RowSel = MSFlexGrid1.row
End Sub

Private Sub MSFlexGrid1_DblClick()
   MSFlexGrid1_keypress 13
End Sub

Private Sub MSFlexGrid1_LeaveCell()
   If bb = 2 And MSFlexGrid1.Text <> Text1.Text Then
    MSFlexGrid1.Text = Text1.Text
   ' Call draw_line
   End If
End Sub

Private Sub showtextbox()
    Dim testx, testy As Long
   ' frmpro.Show 1
    Text1.Visible = 0
    Text1.Height = MSFlexGrid1.CellHeight
    Text1.Width = MSFlexGrid1.CellWidth
    
    testx = MSFlexGrid1.Left + MSFlexGrid1.CellLeft
    testy = MSFlexGrid1.Top + MSFlexGrid1.CellTop

    Text1.Left = testx: Text1.Top = testy

    Text1.ZOrder    'make sure it's on top!
    Text1.Visible = -1  'show it
     Text1.SetFocus 'make it active
End Sub

Private Sub MSFlexGrid1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
 
  If Button = 2 Then
   If Text1.Text <> MSFlexGrid1.Text Then MSFlexGrid1.Text = Text1.Text
   If MSFlexGrid1.row > MSFlexGrid1.RowSel Then
    del1$ = Trim$(Str$(MSFlexGrid1.RowSel - MSFlexGrid1.FixedRows + 1)): del2$ = Trim$(Str$(MSFlexGrid1.row - MSFlexGrid1.FixedRows + 1))
   Else
    del1$ = Trim$(Str$(MSFlexGrid1.row - MSFlexGrid1.FixedRows + 1)): del2$ = Trim$(Str$(MSFlexGrid1.RowSel - MSFlexGrid1.FixedRows + 1))
   End If
   If MSFlexGrid1.col > MSFlexGrid1.ColSel Then
    col1$ = Trim$(Str$(MSFlexGrid1.ColSel - MSFlexGrid1.FixedCols + 1)): col2$ = Trim$(Str$(MSFlexGrid1.col - MSFlexGrid1.FixedCols + 1))
   Else
    col1$ = Trim$(Str$(MSFlexGrid1.col - MSFlexGrid1.FixedCols + 1)): col2$ = Trim$(Str$(MSFlexGrid1.ColSel - MSFlexGrid1.FixedCols + 1))
   End If
  
   jbz = 0
   If Val(del2$) + 1 <= MSFlexGrid1.Rows - 1 Then
    For i = Val(del2$) + 1 To MSFlexGrid1.Rows - 1
     For j = 1 To MSFlexGrid1.Cols - 1
      If MSFlexGrid1.TextMatrix(i, j) <> "" Then jbz = 1: GoTo 2
     Next j
    Next i
   End If
2  If jbz = 0 Then del_line.Enabled = 0 Else del_line.Enabled = -1
  
   seli = 0
   For i = MSFlexGrid1.Rows - 1 To MSFlexGrid1.row Step -1
    For j = 1 To MSFlexGrid1.Cols - 1
     If MSFlexGrid1.TextMatrix(i, j) <> "" Then seli = i: GoTo 3
    Next j
   Next i
3  If seli <> 0 Then insline_max = MSFlexGrid1.Rows - 1 - seli Else insline_max = 0
   If insline_max > 0 Then ins_line.Enabled = -1 Else ins_line.Enabled = 0
  
   PopupMenu operate
  End If
End Sub

Private Sub MSFlexGrid1_Scroll()
  If MSFlexGrid1.col < MSFlexGrid1.LeftCol Or MSFlexGrid1.row < MSFlexGrid1.TopRow Then Text1.Visible = 0: Exit Sub
  If MSFlexGrid1.col <> MSFlexGrid1.Cols - 1 And MSFlexGrid1.row <> MSFlexGrid1.Rows - 1 Then
   If Not (MSFlexGrid1.ColIsVisible(MSFlexGrid1.col + 1)) Or Not (MSFlexGrid1.RowIsVisible(MSFlexGrid1.row + 1)) Then Text1.Visible = 0: Exit Sub
  Else
   If Not (MSFlexGrid1.ColIsVisible(MSFlexGrid1.col)) Or Not (MSFlexGrid1.RowIsVisible(MSFlexGrid1.row)) Then Text1.Visible = 0: Exit Sub
  End If
  If (MSFlexGrid1.CellLeft + MSFlexGrid1.CellWidth) > MSFlexGrid1.Width Then Text1.Visible = 0:   Exit Sub
  If (MSFlexGrid1.CellTop + MSFlexGrid1.CellHeight + Text1.Height) > MSFlexGrid1.Height Then Text1.Visible = 0:   Exit Sub
  Call showtextbox
End Sub







Private Sub SSCommand1_Click() '调用数据
kr_frt$(1) = "#0.000": kr_frt$(2) = "#0.0000": kr_frt$(3) = "#0.0000"
  kr_frt$(4) = "#0.0000": kr_frt$(5) = "#0.0000": kr_frt$(6) = "#0.0000"
  kr_frt$(7) = "#0": kr_frt$(8) = "#0"

Dim b(1 To 10)
Dim A(1 To 100, 1 To 10)
On Error GoTo myerrr
CommonDialog1.filename = ""
'CommonDialog1.Flags = 600

CommonDialog1.InitDir = workpath
CommonDialog1.Filter = "(*.xls)|*.xls|(*.mdb)|*.mdb"

CommonDialog1.ShowOpen
filename1 = CommonDialog1.filename

Dim oleExcel As Object
 Set oleExcel = CreateObject("Excel.Application")
  oleExcel.Visible = False
Dim Count As Integer
 On Error GoTo myerrr
If Right$(filename1, 3) = "XLS" Or Right$(filename1, 3) = "xls" Then

    
 oleExcel.Workbooks.Open filename:=filename1
i = 1
Do
i = i + 1
A(i, 1) = oleExcel.Worksheets("投资表").Range("A1").Cells(i, 1): A(i, 2) = oleExcel.Worksheets("投资表").Range("b1").Cells(i, 1)
A(i, 3) = oleExcel.Worksheets("投资表").Range("c1").Cells(i, 1)
  A(i, 4) = oleExcel.Worksheets("投资表").Range("d1").Cells(i, 1)

 A(i, 5) = oleExcel.Worksheets("投资表").Range("e1").Cells(i, 1)
  A(i, 6) = oleExcel.Worksheets("投资表").Range("f1").Cells(i, 1)
   A(i, 7) = oleExcel.Worksheets("投资表").Range("g1").Cells(i, 1)
Loop While A(i, 1) <> 0
 Count = i - 2
 
  VarPingJiaQi = Count
   TxtNianXian.Text = Str(Count)
   
  ' FrmShengCheng.MSFlexGrid1.Rows = count + 1
   
 

   
 
  For i = 1 To Count
  VarTouZi(i) = A(i + 1, 2)
       varzchbl(i) = A(i + 1, 3)
       varzchnl(i) = A(i + 1, 4)
       
       VarLiuDongZiJin(i) = A(i + 1, 5)
        vardkbl(i) = A(i + 1, 6)
         vardknl(i) = A(i + 1, 7)
  Next i
 
oleExcel.DisplayAlerts = False
oleExcel.Quit
Set oleExcel = Nothing



 Else

  
 
 Dim ss1, ss2 As Double
   Count = 0        '表中的记录数
   ss1 = 0: ss2 = 0        '合计
  ' MsgBox OpeningDatabase
  On Error GoTo myerrr
  ''******************修改纪录***********************
  Set Data1 = New ADODB.Connection
  Data1.CursorLocation = adUseClient
  Data1.Open "Provider=Microsoft.Jet.OLEDB.4.0;data source=" & filename1
  Set adozjyyyhg = New ADODB.Recordset
  adozjyyyhg.Open "select * from 投资表", Data1, adOpenStatic, adLockOptimistic
   
   'Data1.Refresh
   With adozjyyyhg
  ' .OpenRecordset
      .Update
      If (.EOF = True) And (.BOF = True) Then
         'MsgBox "数据库无记录"
       .MoveLast
      
      Else
        .MoveFirst
         Do While .EOF = False
           Count = Count + 1
           .MoveNext
         Loop
       'MsgBox "数据库共有" & Count & "条记录"
     End If
     
   End With
   VarPingJiaQi = Count
    TxtNianXian.Text = Str(Count)
   'Data1.Refresh
   adozjyyyhg.MoveFirst
   
   For i = 1 To Count
       'FrmTouZi.MSFlexGrid1.TextArray(2 * I + 1) = form1.data1.Recordset.Fields(1).Value
       VarTouZi(i) = adozjyyyhg.Fields(1).Value
       varzchbl(i) = adozjyyyhg.Fields(2).Value
       varzchnl(i) = adozjyyyhg.Fields(3).Value
       
       VarLiuDongZiJin(i) = adozjyyyhg.Fields(4).Value
        vardkbl(i) = adozjyyyhg.Fields(5).Value
         vardknl(i) = adozjyyyhg.Fields(6).Value


      ' MsgBox VarLiuDongZiJin(I)
       adozjyyyhg.MoveNext
  Next i
  adozjyyyhg.Close
 ' For i = 1 To Count
      'VarHuaXueji(i, 1) = i
 ' Next i
 End If
  mTotalRows& = Str(Count)
  MSFlexGrid1.Rows = mTotalRows& + 1
  
  For m = 1 To mTotalRows&
    MSFlexGrid1.RowHeight(m) = 400  '设定高度
   MSFlexGrid1.ColAlignment(0) = 4
  
    MSFlexGrid1.ColAlignment(1) = 4
     MSFlexGrid1.TextMatrix(m, 1) = Format$(VarTouZi(m), kr_frt$(1))
      MSFlexGrid1.ColAlignment(2) = 4
     MSFlexGrid1.TextMatrix(m, 2) = Format$(varzchbl(m), kr_frt$(2))
      MSFlexGrid1.ColAlignment(3) = 4
     MSFlexGrid1.TextMatrix(m, 3) = Format$(varzchnl(m), kr_frt$(1))
      MSFlexGrid1.ColAlignment(4) = 4
     MSFlexGrid1.TextMatrix(m, 4) = Format$(VarLiuDongZiJin(m), kr_frt$(2))
      MSFlexGrid1.ColAlignment(5) = 4
     MSFlexGrid1.TextMatrix(m, 5) = Format$(vardkbl(m), kr_frt$(1))
      MSFlexGrid1.ColAlignment(6) = 4
     MSFlexGrid1.TextMatrix(m, 6) = Format$(vardknl(m), kr_frt$(2))
    Text1.Text = MSFlexGrid1.Text
  MSFlexGrid1.TextMatrix(m, 0) = m
  Next m
  
 
     
    
  
  Exit Sub
myerrr:
MousePointer = 0
   Me.Enabled = -1
       Me.MousePointer = 1


oleExcel.DisplayAlerts = False
oleExcel.Quit
Set oleExcel = Nothing


End Sub


Public Sub ShengChengGrideAdd()      '将网格中的数据添加到数据库中的"数据输入表"
 
  Dim Count
  Count = Val(TxtNianXian.Text)
  VarPingJiaQi = Count
  
  On Error GoTo myerrr
  Set Data1 = New ADODB.Connection
  Data1.CursorLocation = adUseClient
  Data1.Open "Provider=Microsoft.Jet.OLEDB.4.0;data source=" & OpeningDatabase
  Set adozjyyyhg = New ADODB.Recordset
  
  adozjyyyhg.Open "select * from 投资表", Data1, adOpenStatic, adLockOptimistic
   With adozjyyyhg
    'MsgBox "eof=" & .EOF & "BOF=" & .BOF
    If Not ((.EOF = True) And (.BOF = True)) Then
      .MoveLast
    End If
    Do While .BOF = False
       .Delete
       .MovePrevious
    Loop
    If (.BOF = False) Then
      .MoveFirst
      .Delete
    End If
    
    For i = 1 To Count
        .AddNew                            ' 将网格中的数据添加到数据库中的"化学剂用量参数表"
        For k = 0 To 6
          If MSFlexGrid1.TextArray(i * 7 + k) = "" Then
             Str1 = "0"
          Else
             Str1 = MSFlexGrid1.TextArray(i * 7 + k)
          End If
         .Fields(k).Value = Str1
         
        Next k
        .Update
      Next i
     
       
            
        
        
      'Exit Sub